{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 "Times" 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 "Times" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 468 "Times" 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 } {CSTYLE "" -1 480 "Times" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{PSTYLE "No rmal" -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 "Text Output" -1 2 1 {CSTYLE " " -1 -1 "Courier" 1 10 0 0 255 1 0 0 0 0 0 1 3 0 3 0 }1 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "Warning" 2 7 1 {CSTYLE "" -1 -1 "" 0 1 0 0 255 1 0 0 0 0 0 0 1 0 0 0 }0 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "M aple Output" -1 11 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "Maple Output" -1 12 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 3 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "R3 Font 0" -1 256 1 {CSTYLE "" -1 -1 "He lvetica" 1 12 0 0 255 1 2 1 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "R3 Font 2" -1 257 1 {CSTYLE "" -1 -1 "Times" 1 12 255 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "Normal " -1 258 1 {CSTYLE "" -1 -1 "Helvetica" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }} {SECT 0 {EXCHG {PARA 258 "" 0 "" {TEXT -1 29 "\nThis is clifford_M12_1 2.mws\n" }}{PARA 258 "" 0 "" {TEXT -1 29 "(Created: December 20, 2009) \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "########################### ##################################################\n# \+ #\n#DISCLAIM ER: #\n # \+ #\n#THERE IS NO WARRANTY FOR THE CLIFFORD, BIGEBRA, Cliplus, Oct onion, GTP #\n#PACKAGES TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AN D/OR OTHER PARTIES PROVIDE THE #\n#PROGRAM \"AS IS\" WITHOUT WARRANT Y OF ANY KIND, EITHER EXPRESSED OR IMPLIED, #\n#INCLUDING, BUT NOT LIM ITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY #\n#AND FITNESS F OR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY #\n#AND \+ PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE \+ #\n#DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR #\n#CORRECTION. \+ #\n################################################ #############################\n" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 325 "\nThis is a listing (without examples) of all procedures in a Maple package called 'CLIFFORD' (Version 12, \+ Copyright 1995-2009 by Rafal Ablamowicz, Tennessee Technological Univ ersity), and Bertfried Fauser, Universit\"at Konstanz, for Maple 12. \+ User will know which version he/she is using by using the 'version()' \+ function." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 277 55 "The following procedures can use index such as K or -K:" }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 66 "cmul[K](p 1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K)" }}{PARA 0 " " 0 "" {TEXT -1 81 "&c[K](p1,p2,...,pn); ##Clifford product of p1,p2,. ..,pn in Cl(K) (ampersand form)" }}{PARA 0 "" 0 "" {TEXT -1 112 "cmulQ [K](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) (he re K is expected to be a diagonal matrix), ampersand form" }}{PARA 0 " " 0 "" {TEXT -1 56 "cexp[K](p,N); ## exponential of p in Cl(K) up to o rder N" }}{PARA 0 "" 0 "" {TEXT -1 102 "cexpQ[K](p,N); ## exponential \+ of p in Cl(K) up to order N (here K is expected to be a diagonal matri x)" }}{PARA 0 "" 0 "" {TEXT -1 53 "climinpoly[K](p); ## minimal polyno mial of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 91 "sexp[K](p,N); ## ex ponential 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 "Th e 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); ##left contraction of p2 by p1 w.r.t . K\nRC(p1,p2,K); ##right contraction of p1 by p2 w.r.t. K" }}{PARA 0 "" 0 "" {TEXT -1 68 "cmulNUM(m1,m2,K); ##Clifford (numeric) product of m1 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); ##C lifford inverse of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 73 "LCQ(p1,p 2,K); ##left contraction of p2 by p1 w.r.t. diagonal entries in K" }} {PARA 0 "" 0 "" {TEXT -1 74 "RCQ(p1,p2,K); ##right contraction of p1 b y p2 w.r.t. diagonal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 46 "conj ugation(p,K); ## conjugation of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 279 86 "The folllowing procedures can \+ pass on name or a numeric multiple of a name via a list:" }}{PARA 0 " " 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 121 "type([p,K],nilpot ent); ## checks if p is nilpotent in Cl(K)\ntype([p,K],idempotent); ## checks if p is idempotent in Cl(K)" }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 580 "\nProcedures that define types: `t ype/climon`, `type/clipolynom`, `type/climatrix` as well as other proc edures such as 'reorder', 'wedge', etc., have been substantially revis ed to improve efficiency and speed of the package. This work has been \+ done together with Bertfried Fauser, Universit\"at Konstanz, in Cookev ille on October 5, 2001. \n\nThis version includes \"Bigebra\" package that has been created together with Bertfried Fauser, Universit\"at K onstanz, Konstanz, Germany. Additional help pages have been written an d added to the database that explain the usage of this package." } {TEXT 276 0 "" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 302 "An additional feature in this version is an ability to d isplay and change environmental variables. They can be displayed with \+ procedure CLIFFORD_ENV.\n\nThis package is made to run under Maple 12 . It is available on a server of the Department of Mathematics, Tenn essee Technological University, at: \n" }}{PARA 258 "" 0 "" {TEXT -1 69 " http://math.tntech.edu/rafal/clifford / " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 130 "In order to create a Maple file 'Clifford.m' containing the 'CLIF FORD' package, execute this worksheet.\n\nTo load the package type:" } }{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">wit h(Clifford); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 189 "You will know if the package has been loaded because a l ist with Clifford procedures will be displayed on the screen. To chec k the current version of the package, at the Maple prompt type " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 12 ">vers ion( );" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 35 "Rafal Ablamowicz, Ph.D. and Chair " }}{PARA 258 "" 0 "" {TEXT -1 35 "Department of Mathematics, Box 5054" }}{PARA 258 "" 0 "" {TEXT -1 36 "Tennessee Technological University " }}{PARA 258 "" 0 "" {TEXT -1 21 "Cookeville, TN 38505 " }}{PARA 258 "" 0 "" {TEXT -1 24 "r ablamowicz@tntech.edu " }}{PARA 258 "" 0 "" {TEXT -1 25 "phone: USA ( 931) 372-3569" }}{PARA 258 "" 0 "" {TEXT -1 23 "fax: USA (931) 372-635 3" }}{PARA 0 "" 0 "" {TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 "restart:\nunprotect('Clifford','e','qi','qj','qk','Id','w');" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 989 "Clifford:=module()\n############## #####################\nexport `&m`, Bsignature, CLIFFORD_ENV, Kfield, \+ LC, LCQ, RC, RCQ, RHnumber, adfmatrix, all_sigs, beta_minus, beta_plus , buildm, bygrade, c_conjug, cbasis, cdfmatrix, cexp, cexpQ, cinv, cli bilinear, clicollect, clidata, clilinear, climinpoly, cliparse, clirem ove, clisolve, clisort, cliterms, cmul, cmulNUM, cmulQ, cmulRS, cmulge n, cocycle, commutingelements, conjugation,ddfmatrix, diagonalize, dis playid, extract, factoridempotent, find1str, findbasis, gradeinv, init , isVahlenmatrix, isproduct, makealiases, makeclibasmon, matKrepr, max grade, maxindex, mdfmatrix, minimalideal, ord, permsign, pseudodet, q_ conjug, qdisplay, qinv, qmul, qnorm, reorder, reversion, rmulm, rot3d, scalarpart, sexp, specify_constants, spinorKbasis, spinorKrepr, squar emodf, subs_clipolynom, useproduct, vectorpart, version, wedge, wexp, \+ rd_clibasmon, rd_climon, rd_clipolynom;\n############################# ######\nlocal setup;\noption package, load=setup;\n" }}{PARA 258 "" 0 "" {TEXT -1 84 "No. 1. Name 'version' stores information about the cur rent version of the package. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 25 "Typical use: version(); " }}{PARA 0 " " 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1515 "version:= \+ proc()\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Decemb er 20, 2009`;\nprint(`+++++++++++++++++++++++++++++++++++++++++++`);\n print(`CLIFFORD - A Maple 12 Package for Clifford Algebras with \"Bige bra\"`); \nprint(`(Version 12 with environmental variables given by CL IFFORD_ENV())`);\nprint(`Last revised: December 20, 2009 (Source file: clifford_M12_12.mws)`);\nprint(`Copyright 1995-2009 by Rafal Ablamowi cz (*) and Bertfried Fauser ($)`);\nprint(``);\nprint(`(*) Department \+ of Mathematics, Box 5054`);\nprint(` Tennessee Technological Univer sity, Cookeville, TN 38505`);\nprint(` tel: USA (931) 372-3569, fax : USA (931) 372-6353`);\nprint(` rablamowicz@tntech.edu`);\nprint(` http://math.tntech.edu/rafal/`);\nprint(`($) Universit\"at Konstan z, Fachbereich Physik, Fach M678`);\nprint(` 78457 Konstanz, German y`);\nprint(` Bertfried.Fauser@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 se e`);\nprint(`how much faster your computations will be! But watch your syntax!`);\nprint(`Use 'useproduct' to change value of _default_Cliff ord_product in Cl(B) from`);\nprint(`cmulRS when B is symbolic to cmul NUM when B is numeric. Type ?cmul for help.`);\nprint(`Type CLIFFORD_E NV() to see current values of environmental variables.`); \nprint(`+++ +++++++++This is CLIFFORD version 12++++++++++++`);\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 17 "No. 2. Procedure " }{TEXT 282 17 "speci fy_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 v ariable 'constants' and must be saved separately, if needed. This pro cedure is needed when sorting or collecting multivariate Clifford poly nomials containing expressions like 'aa*eiwej' in which 'aa' is intend ed to be a constant and 'eiwej' is intended to be a Clifford basis mon omial with indices i and j. Before using " }{TEXT 281 7 "clisort" } {TEXT -1 4 " or " }{TEXT 280 10 "clicollect" }{TEXT -1 350 " user shou ld make any additional constants of length 2 or more known to Maple as shown below. If these constants of length 2 or more are not defined \+ as Maple constants, then some procedures might yield error messages (a lthough an attempt has been made to avoid this problem). Constants of \+ length one are automatically assumed to be Maple constants. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use : specify_constants(a, b, B, aa); " }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 186 "NOTE: from now on, extra spaces ha ve been added for the Reader's convenience in the sequence of input va riables as in the above example. These spaces are not needed or requir ed by Maple." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 372 "specify_constants:=proc(a1::anything) global constan ts;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: December \+ 20, 2008`;\n#############################################\nconstants:= op(\{constants,args\});\nprintf(\"Maple now knows the following consta nt(s): %q\\n\",constants);\nreturn NULL;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 21 "No. 3. The procedure " }{TEXT 283 6 "cbasis" }{TEXT -1 793 " writes a canonical basis for a Clifford algebra Cl(B) over a \+ vector space V endowed with a bilinear form B. The dimension of V is \+ specified by a Maple global variable 'dim' where 1 <= dim <= 9. This \+ procedure can be used with one or two arguments as, for example, in cb asis(4) or cbasis(4, 2). In the first case, it returns a list of all \+ basis elements in the Clifford algebra Cl(4). In the second case, it r eturns a list of basis elements in the 2-vector subspace of Cl(4). Bel ow, 'Id' stands for the algebra unit element and 'w' denotes wedge/ext erior product in the Clifford algebra. An option 'even' allows one to \+ create a basis in the even subalgebra of the given Clifford algebra as in cbasis(3, 'even'). In fact, 'even' can be replaced with any name \+ which evaluates to a string. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1876 "cbasis:=proc(a1::nonnegint,a2::\{string,symbol,nonnegint\})\nloc al i,k,X,XX,YY,L,Leven,Lodd,bas,nxt,ind,start; global choose,e;\noptio ns `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`,remember;\ndescription `Last revised: December 2 0, 2008`;\n#############################################\nif a1>9 then \n error \"first argument must be between 0 and 9 inclusive but rec eived %1 instead\",a1 \nend if;\nif a1=0 and nargs=1 then return [Id] \+ end if;\nif nargs=2 and type(a2,\{string,symbol\}) then do\n L:=proc name(a1):\n Leven:=[Id]:Lodd:=[]:\n if nops(L) > 1 then\n for i \+ from 2 to nops(L) do\n if type(length(L[i]),odd) then Leven:=[op (Leven),L[i]] else\n Lodd:=[op(L odd),L[i]]\n end if \n end do \n end if; \nif args[2]='even' then return Leven \n elif args[2]='odd' then return Lodd\n else e rror \"second argument must be an integer or a string 'even' or 'odd' \+ but received %1 instead\",args[2]\nend if\nend do \nend if;\nfor k fro m 0 to a1 do \n X[k]:=combinat[choose]([seq(i,i=1..a1)],k) \nend do ;\nif not nargs = 1 and not nargs = 2 then \n error \"one or two arg uments are needed as input but received %0 instead\",args\nelif nargs \+ = 1 then XX:=[seq(op(X[k]),k=0..a1)] \nelse if not a2 >= 0 or not a2 < = a1 then \n error \"second argument must satisfy: 0 <= 'a2' <= %1 but received %2 instead\",a1,a2 \nelse XX:=X[a2] \nend if \nend if;\nYY: =array(1..nops(XX),[]);start:=1:\nif XX[1] = [] then \n YY[1]:=Id; \+ \n start:=2 \nend if;\nfor k from start to nops(XX) do\n ind:=XX[ k][1];\n if ind=10 then \n bas:=e||0 else bas:=e||ind \n e nd if;\nfor i from 2 to nops(XX[k]) do \n ind:=XX[k][i]:\n if in d=10 then nxt:=e||0 else nxt:=e||ind end if:\n bas:=cat(bas,\"w\", nxt): \n end do;\nYY[k]:=bas;\nend do:\nYY:=convert(YY,list);\npr otect(op(YY)); #protect basis monomials\nreturn YY\nend proc:\n " }} {PARA 258 "" 0 "" {TEXT -1 17 "No. 4. Procedure " }{TEXT 284 8 "find1s tr" }{TEXT -1 327 " finds all locations of the first string of length \+ one in the second string of length at least one. It returns a set of t hese positions. If the first string is not found then it returns \{0 \}. This procedure is primarily for internal use in 'type/clibasmon' a nd 'cliparse'. \nTypical use: find1str(e,e1we2we3); find1str(w,e1we2); " }{MPLTEXT 0 21 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 663 "find1str :=proc(a1::symbol,a2::symbol) local ns,p,p1,ap,le2;\nglobal _prolevel; \noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`,remember;\ndescription `Last revised: Dec ember 20, 2008`;\n#############################################\nle2:= length(a2):\nif _prolevel=false then\nif length(a1) <> 1 or le2<1 then \n error \"first string must be of length 1 but received %1 instead \",a1 \nend if;\nend if;\np:=SearchText(a1,a2):\nap:=\{p\}:p1:=p:\nwh ile p<>0 and p10 then p1:=p1+p;\n ap:=ap union \{p1\} \n end if;\nend do;\nreturn ap\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 5. Function " }{TEXT 285 8 "cliparse" }{TEXT -1 349 " checks user's input for correct spelling of basis monomials. Wh en unable to decide if the given input is correct, it tells the user t o check spelling or define the given string as a Maple constant. If th e spelling is correct, it returns true; if it is not correct, it retur ns a set of suspect words.\n \nTypical use: cliparse(e1+e2we3+2*Pi*B[1 ,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1180 "cliparse:=proc(a1::any thing) local x,S1,S2,p,S;\nglobal _prolevel,_scalartypes;\noptions `Co pyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: December 20, 2008`;\n#### #########################################\nif _prolevel then return tr ue end if;\nif type(a1,_scalartypes) then return true end if;\np:=remo ve(type,a1,_scalartypes):S1:=\{op(p)\}:\nfor x in S1 do \n if type( x,_scalartypes) or type(x,clibasmon) then S1:=S1 minus \{x\} end if;\n end do; \nS2:=map(op,S1); \nfor x in S2 do \n if type(x,_scalartype s) or type(x,clibasmon) then S2:=S2 minus \{x\} end if;\nend do;\nS:=r emove(hastype,map(op,\{op(expand(p))\}),\{op(_scalartypes),clibasmon\} );\nfor x in S do \n if find1str(e,x)=\{0\} and x<>'Id' then S:=S m inus \{x\} end if;\nend do;\nif S=\{\} then return true end if;\nS1:=s elect(type,S,procedure):\nif S1 <> \{\} then\n error \"procedure nam e %1 that has been found in input is not allowed as a symbolic coeffic ient\",op(S1)\nend if;\nif nops(S)=1 then \n error \"check spelling \+ of %1 or define it as a constant or an alias\",op(S)\nelse \n error \+ \"check spelling of %1 or define them as constants or aliases\",op(S) \+ \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 6. Functi on " }{TEXT 286 9 "displayid" }{TEXT -1 186 " replaces a user-entered \+ Clifford scalar with the scalar times the unit element 'Id'. It may al so be applied to matrices with Clifford algebra entries.\n\nTypical us e: displayid(e1+2*Pi);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 622 "displa yid:=proc(a1::\{array,matrix,algebraic\}) local KK,p;\noptions `Copyri ght (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n######## #####################################\nKK:=proc() if type(args[1],clis calar) then return args[1]*Id \n elif hastype(args[1],clibas mon) then return args[1] \n end if \nend proc:\nif type(a1, \{array,matrix\}) then return map(procname,a1) end if;\np:=expand(a1): \nif type(p,\{`*`,cliscalar,clibasmon,climon\}) then return KK(p) \nel if type(p,\{`+`\}) then return map(KK,p) \nelse return a1 \nend if;\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 7. Procedure " } {TEXT 287 8 "cliterms" }{TEXT -1 222 " identifies Clifford basis eleme nts in the given Clifford polynomial.\n\nNOTE: 'cliterms' also works w ith terms of type cliprod and it finds correctly terms involving such \+ expressions. \n\nTypical use: cliterms(2*Pi+2*e1we2);\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 1020 "cliterms:= proc(a1::anything) local S1,S2,S3 ,x,p,Cliplusflag;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: December 20, 2008`;\n############################################ #\nCliplusflag:=assigned(Cliplus):\nif hastype(a1,cliprod) and not Cli plusflag and _warnings_flag then \n WARNING(`argument to 'cliterms' \+ contains type cliprod. Load 'Cliplus' to extend functionality of CLIF FORD. Type ?cliprod for help.`)\nend if;\nif type(a1,\{clibasmon,clipr od\}) then return \{a1\} end if;\np:=displayid(simplify(a1)):\nif hast ype(p,cliprod) then \n S1:=remove(type,\{op(p)\},cliscalar);\n S2: =select(hastype,S1,\{clibasmon,climon,cliprod\});\n S3:=\{\}:\n wh ile not S2=\{\} do\n S3:=S3 union select(type,S2,\{clibasmon,c liprod\});\n S2:=select(hastype,map(op,remove(type,S2,\{clibas mon,cliprod\})),\{clibasmon,cliprod\});\n end do;\nreturn S3\nend if ;\nx:='x':\nS1:=remove(type,\{op(p)\},cliscalar);\nreturn \{seq(select (hastype,x,clibasmon),x=S1)\}\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 8. Procedure " }{TEXT 288 11 "clibilinear" }{TEXT -1 360 " \+ makes any procedure K specified as the third argument bilinear with re spect to Clifford scalars in the first two arguments. The first two ar guments are of the type clipolynom, i.e., Clifford polynomials. The th ird argument is a string or a procedure.\nIt can handle terms involvin g elements of type cliprod.\n\nTypical use: clibilinear(e1+2*e2we3,Id+ 2*e2+e3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 923 "clibilinear:=proc (a1,a2,a3::\{procedure,name,symbol,matrix,array\}) \n loca l tail,p1,p2,S1,S2,S12,res,x,y,cli1,cli2,co1,co2;\noptions `Copyright \+ (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: December 20, 2008`;\n############ #################################\nif simplify(a1)=0 or simplify(a2)=0 then return 0 end if; \np1:=clicollect(a1):\np2:=clicollect(a2):\n t ail:=args[4..-1];\n if type(p1,\{climon,cliprod\}) then S1:=[p1] else S1:=[op(p1)] end if:\n if type(p2,\{climon,cliprod\}) then S2:=[p2] \+ else S2:=[op(p2)] end if:\n S12:=[seq(seq([x,y],x=S1),y=S2)];#this li st will be huge for long polynomials\n res:=0:\n for x in S12 do \n \+ cli1:=select(type,x[1],\{cliprod,clibasmon\}):\n cli2:=select(ty pe,x[2],\{cliprod,clibasmon\}):\n co1:=coeff(x[1],cli1):\n co2:= coeff(x[2],cli2):\n res:=res+co1*co2*a3(cli1,cli2,tail):\n end do: \n return res;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 9. \+ Procedure " }{TEXT 289 9 "clilinear" }{TEXT -1 336 " makes any procedu re K specified as the second argument linear with respect to Clifford \+ scalars (elements of type cliscalar). It can now distribute over Cliff ord polynomials with elements of `type/cliprod`. Any additional parame ters are passed on to the procedure entered as the second argument.\nT ypical use: clilinear(a*e1+2*e2we3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 622 "clilinear:=proc(a1::\{symbol,cliscalar,clibasmon,cli mon,clipolynom\},a2::\{name,procedure\}) \nlocal tail,p1,S1,res,x,cli1 ,co1;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Decembe r 20, 2008`;\n#############################################\ntail:=arg s[3..-1];\nif type(a1,cliscalar) then return a1*a2(Id,tail) end if;\np 1:=displayid(a1):\nif type(p1,climon) then S1:=[p1] else S1:=[op(p1)] \+ end if:\nres:=0:\nfor x in S1 do\n cli1:=select(hastype,x,\{clibasm on,cliprod\}):\n co1:=coeff(x,cli1); \nres:=res+co1*a2(cli1,tail): \nend do:\nreturn res\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "N o. 10. Procedure " }{TEXT 290 7 "clisort" }{TEXT -1 312 " sorts the gi ven multivariate Clifford polynomial with respect to the Clifford inde tereminates found in the expression via the procedure 'cliterms'. It p uts scalar coefficients of the type cliscalar in front of the Clifford basis monomials. It may also be applied to matrices with entries in a Clifford algebra. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 40 "Typical use: clisort(2*e1we2 - e1*b); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 440 "clisort:=proc(p::algebraic) local L,N;\n options `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: December 20, 2 008`;\n#############################################\nif type(p,matrix ) then return map(procname,p) end if;\nif type(eval(p),\{climon,clipol ynom\}) or hastype(eval(p),cliprod) then\n L:=cliterms(expand(displa yid(p)));\n return sort(p,L);\nend if:\nreturn p\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 19 "No. 11. Procedure " }{TEXT 291 10 "cli collect" }{TEXT -1 382 " reorders monomial terms in standard order and then collects them in a multivariate Clifford polynomial. It may also be applied to matrices with entries in a Clifford algebra. It will si mplify 6 + 7*Id to 13*Id. It collects now terms of type cliprod, if p resent.\n\nNOTE: 'clicollect' also works with terms of type cliprod an d it collects correctly terms involving such expressions. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use : clicollect(e1 + a*e1 - e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 497 "clicollect:=proc(a1::algebraic) local p,L; \noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: December 20, 2008`;\n########### ##################################\nif type(a1,matrix) then return map (procname,a1) end if;\np:=expand(a1):\nif type(p,cliscalar) then retur n p*Id\nelif type(p,clipolynom) then \n L:=cliterms(p);\n retu rn map(simplify,collect(displayid(p),L,'distributed'))\nelse return ar gs[1] \nend if\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 12. \+ The procedure " }{TEXT 292 3 "ord" }{TEXT -1 319 " returns an ordered list of positions in a monomial, e.g., e1we2, where vector indices \+ are found. Then, nops(ord(e1we2)) can be used to find the order of th e monomial. Note that for consistency we have ord(Id) = ord(numeric) \+ = ord(numeric*Id) = ord(cliscalar)=[] where cliscalar is any object of the type cliscalar." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 35 "This procedure is for internal use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 387 "ord:=proc(a1) local v,k;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: D ecember 20, 2008`;\n#############################################\nif \+ type(a1,cliscalar) then return [] end if;\nv:=select(type,a1,clibasmon );\nif v = Id then return [] end if;\nk:='k':\nreturn [seq(2+3*k,k=0.. ((length(v)+1)/3-1))]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "N o. 13. Procedure " }{TEXT 293 9 "cliremove" }{TEXT -1 193 " removes o ne symbol 'ei' from the location specified by the procedure 'ord'. \n( NOTE: procedure 'ord' specifies location of the index 'i' in 'ei'.) T his procedure is primarily for internal use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 579 "cliremove:=proc(p::posin t,s::symbol) local S1,S2;global _prolevel;\noptions `Copyright (c) 199 5-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.` ,remember;\ndescription `Last revised: December 20, 2008`;\n########## ###################################\nif not _prolevel then\n if s=Id then error \"second argument must be Grassmann basis monomial of rank >= 1\" end if;\nend if;\nS2:=substring(s,(p+2)..length(s));\nS1:=subs tring(s,1..(p-3));\nif length(S2)=0 and S1 <> s then return S1 \n el if S1 = s then return S2 \n else return cat(S1,\"w\",S2); \nend if; \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. Procedure " } {TEXT 294 7 "extract" }{TEXT -1 445 " extracts indices of a monomial ( or a constant times a monomial) and it returns them as a list of strin gs. If necessary, they can be returned as a list of integers if optio n 'integers' is selected (in fact, any name which evaluates to a strin g may be used as the option). Indices could be now integers, letters, or they could be mixed. Note that extract(Id) = [] and extract(numeri c) = extract(numeric*Id) = [] results in no vector indices. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 63 "Typic al use: extract(2*e1we2); or extract(e2we3, \"integers\"); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 732 "extract: =proc(a1,a2) \nlocal v,k,inds;global _prolevel,str_to_int;\noptions `C opyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`,remember;\ndescription `Last revised: December 20, 20 08`;\n#############################################\nif type(a1,clisca lar) or (type(a1,symbol) and length(a1)=1) then return [] \nelif\n t ype(a1,\{climon,clibasmon\}) then v:=select(type,a1,clibasmon):\nelse \+ \n error \"wrong argument: %1\",a1 \nend if;\nif v = Id then return \+ [] end if;\ninds:=map(convert,remove(member,StringTools:-Explode(v),\{ \"e\",\"w\"\}),symbol);\nif nargs=1 then return inds \n elif type(a2 ,symbol) then \n return map(parse,inds)\n else error \"wrong option or number of arguments\" \nend if;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 19 "No. 15. Procedure " }{TEXT 295 7 "reorder" } {TEXT -1 330 " reorders Clifford monomials in the given Clifford polyn omial using standard ordering and calculates sign of each permutation, e.g., reorder(e1we3we2) = -e1we2we3, reorder(e2we1 + 2*e1we5we2) = -e 1we2 - 2*e1we2we5. If any one of the indices of the monomial is a lett er, e.g., reorder(eiwe3) = eiwe3, reorder returns its argument. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 139 "Reor der now can order monomials and polynomials with symbolic coefficients , e.g. reorder(ejwei) = -eiwej, using the lexicographic order. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typic al use: reorder(e2we1 + 2*Id + e4we3we1); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1347 "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-2009 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: December 20, 2008`;\n###################################### #######\nif type(a1,\{matrix,`+`,`*`\}) then return map(procname,a1) e nd if; \nL1:=Clifford:-extract(a1);\nN:=nops(L1);\n################### ##################################################################### \n#if N>9 then error \"detected basis monomial of grade higher than 9 \+ in the input\" end if;\n#if N>9 then WARNING(\"detected basis monomial of grade higher than 9 in the input\") end if;\n##################### ###################################################################\ni f 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[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 wh ile 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 "maxind ex" }{TEXT -1 226 " which finds the greatest index in the given Cliffo rd polynomial or in the given list or set of Clifford monomials. It re turns 0 for a Clifford scalar (an element of type cliscalar).\n\nTypic al use: maxindex(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 813 "maxindex:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom,li st,set\}) \nlocal inds,mons,symbinds;\noptions `Copyright (c) 1995-200 9 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: December 20, 2008`;\n######################## #####################\nif type(a1,cliscalar) or a1=Id then return 0 el if\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,'int egers'));\n symbinds:=remove(type,inds,integer);\n if symbinds = \+ \{\} then\n if inds=\{\} then return 0 else return max(op(inds)) \+ end if;\n else\n error \"cannot determine maximum index because input contains symbolic index or indices\"\n end if;\n end if;\nen d proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 35 "No. 17. Defining a useful \+ function " }{TEXT 297 8 "maxgrade" }{TEXT -1 176 " which finds the max imum grade in the given Clifford polynomial. It returns 0 for a Cliff ord scalar (an element of type cliscalar).\n\nTypical use: maxgrade(a* Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 400 "maxgrade:=p roc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local S;\noptions ` Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n## ###########################################\nif type(eval(a1),cliscala r) then return 0 end if;\nS:=\{op(cliterms(eval(a1)))\}:\nreturn max(o p(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 and a multivecto r v, i.e., multivector u acts on the multivector v from the left. Thi s procedure is now bilinear in both arguments. It can accept third ar gument such as K or -K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: LC(e1 + 2*e2, e1we3 + b*e2we3); \+ \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2317 "LC:=proc(x1::\{cliscalar,cl ibasmon,climon,clipolynom\},\n y1::\{cliscalar,clibasmon,climo n,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,lname,res,coB,n ameB,x,y;\n global _CLIENV,B;\noptions `Copyright (c) 1995-2009 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: December 20, 2008`;\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,mat rix,array\}) then\n coB:=1:\n nameB:=args[3];\n lnam e:=args[3];\n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,a rray\})) 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 L C. See ?LC for more help.\" \n end if;\nelse\n error \"two or thr ee arguments expected in LC. See ?LC for more help.\"\n end if;\n##### ###########################\nx,y:=expand(x1),expand(y1): ##NEW\n if t ype(x,clibasmon) then\n if type(y,clibasmon) then\n lst1:=Clif ford:-extract(x,'integers');\n lst2:=Clifford:-extract(y,'integer s');\n N1:=nops(lst1);N2:=nops(lst2);\n if N1>N2 then return 0 end if;\n if N1=0 then return y end if;\n if N1=1 then \n res:=`+`(seq(coB*nameB[lst1[1],lst2[j]]*_CLIENV[_QDEF_PREFACT OR]^(j-1)*\n makeclibasmon([op(subs(lst2[j]=N ULL,lst2))]),j=1..N2));\n return reorder(res) \n else\n \+ res:=\nprocname(makeclibasmon(lst1[1..-2]),procname(makeclibasmon( [lst1[-1]]),y,lname),lname);\n return reorder(res)\n end \+ if;\n elif type(y,climon) then\n term,cf:=selectremove(type, y,clibasmon);\n return expand(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,cliscalar) then \n return disp layid(scalarpart(x)*y)\n end if; \n elif type(x,climon) then\n \+ term,cf:=selectremove(type,x,clibasmon);\n return expand(cf*procn ame(term,y,lname))\n elif type(x,clipolynom) then\n return add(pro cname(i,y,lname),i=[op(x)])\n elif type(x,cliscalar) then \n retur n x*reorder(y)\n end if;\nerror \"Got input %1 and %2 but LC can onl y process constants and Clifford numbers\",x,y;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 19. Procedure " }{TEXT 299 3 "LCQ" } {TEXT -1 270 " is a special version of 'LC' and gives left contraction in the orthogonal Clifford algebra Cl(Q) of the quadratic form Q defi ned via the symmetric part g of B as Q(x) = g(x, x) = B(x, x). It can accept name as a third optional argument or a numeric multiple of a n ame." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 76 "Proposed by Yvon Siret, Universite Joseph Fourier, Grenoble, Franc e. Thanks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 82 "Typical use: LCQ(e1 + 2*e2, e1we3 + b*e2we3);\nLCQ(e1 + 2 *e2, e1we3 + b*e2we3,K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1795 "LC Q:=proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n y::\{ cliscalar,clibasmon,climon,clipolynom\}) \n local ii,N,L,m,Sxy,sym bxy,lname,coB,nameB;global B:\noptions `Copyright (c) 1995-2009 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: December 20, 2008`;\n################################ #############\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lna me:=`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,arra y\})) then\n coB:=op(select(type,\{op(args[3])\},numeric));\n \+ nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=ar gs[3]:\n else \n error \"wrong type of third argument in LCQ. See ?LCQ for more help.\" \n end if;\nelse\n error \"two or thre e arguments expected in LCQ. See ?LCQ for more help.\"\nend if;\n##### ###########################\nSxy:=remove(type,map(op,\{op(x),op(y)\}), cliscalar);\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers'));\nsymb xy:=remove(type,Sxy,posint);\nif 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[cold im](evalm(lname)):\n if m>N then \n error \"input contains inde x larger than size of bilinear form %1\",lname \n end if;\nend if:\n if type(lname,\{name,symbol,array,matrix\}) then\n L:=seq(lname[ii,i i],ii=1..m);\n return LC(x,y,linalg[diag](L))\nelif \n type(lname, `&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op(select(ty pe,\{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 contraction between any multivector u and a mult ivector v, i.e., multivector u acts on the multivector v from the righ t. This procedure is now bilinear in both arguments. It can accept t hird 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*e 2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2280 "RC:=proc(x::\{clisca lar,clibasmon,climon,clipolynom\},\n y::\{cliscalar,clibasmon, climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,lname,res,co B,nameB;\n global _CLIENV,B;\noptions `Copyright (c) 1995-2009 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: December 20, 2008`;\n################################ #############\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lna me:=`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,arra y\})) then\n coB:=op(select(type,\{op(args[3])\},numeric));\n \+ nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=ar gs[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,cl ibasmon) then\n lst1:=Clifford:-extract(x,'integers');\n lst 2:=Clifford:-extract(y,'integers');\n N1:=nops(lst1);N2:=nops(lst 2);\n if N2>N1 then return 0 end if;\n if N2=0 then return x end if;\n if N2=1 then \n res:=`+`(seq(coB*nameB[lst1[-i ],lst2[1]]*_CLIENV[_QDEF_PREFACTOR]^(i-1)*\n makecl ibasmon([op(subs(lst1[-i]=NULL,lst1))]),i=1..N1));\n return re order(res) \n else\n res:=procname(procname(x,makeclib asmon([lst2[1]]),lname),\n makeclibas mon(lst2[2..-1]),lname);\n return reorder(res)\n end if; \n elif type(y,climon) then\n term,cf:=selectremove(type,y,cli basmon);\n return expand(cf*procname(x,term,lname))\n elif typ e(y,clipolynom) then\n return add(procname(x,i,lname),i=[op(y)]) \n elif type(y,cliscalar) then return reorder(x)*y \n end if;\n elif type(x,climon) then\n term,cf:=selectremove(type,x,clibasmon );\n return expand(cf*procname(term,y,lname))\n elif type(x,clipol ynom) then\n return add(procname(i,y,lname),i=[op(x)])\n elif type (x,cliscalar) then \n return displayid(x*scalarpart(y))\n end if; \nerror \"Got input %1 and %2 but can only process constants and Cliff ord numbers\",x,y\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 259 18 "No. 21 . Procedure " }{TEXT 301 3 "RCQ" }{TEXT 302 85 ": Right contraction in Cl(Q). It can accept third optional argument such as K or -K.\n" } {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1800 "RCQ:=proc(x::\{cl iscalar,clibasmon,climon,clipolynom\},\n y::\{cliscalar,cliba smon,climon,clipolynom\}) \n local ii,N,L,m,Sxy,symbxy,lname,coB,n ameB;global B:\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz a nd Bertfried Fauser. All rights reserved.`;\ndescription `Last revised : December 20, 2008`;\n############################################# \+ \nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \nel if nargs=3 then\n if type(args[3],\{name,symbol,matrix,array\}) the n\n coB:=1:\n nameB:=args[3];\n lname:=args[3];\n \+ elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array\})) then\n \+ coB:=op(select(type,\{op(args[3])\},numeric));\n nameB:=op (remove(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n e lse \n error \"wrong type of third argument in RCQ. See ?RCQ for more help.\" \n end if;\nelse\n error \"two or three arguments e xpected in RCQ. See ?RCQ for more help.\"\nend if;\n################## ##############\nSxy:=remove(type,map(op,\{op(x),op(y)\}),cliscalar);\n Sxy:=map(op,map(Clifford:-extract,Sxy,'integers'));\nsymbxy:=remove(ty pe,Sxy,posint);\nif symbxy <> \{\} then \n return RC(x,y,lname) \nen d 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(lna me)):\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(l name,\{name,symbol,array,matrix\}) then\n L:=seq(lname[ii,ii],ii=1.. m);\n return RC(x,y,linalg[diag](L))\nelif \n type(lname,`&*`(nume ric,\{name,symbol,array,matrix\})) then\n coB:=op(select(type,\{op(l name)\},numeric));\n nameB:=op(select(type,\{op(lname)\},\{name,symb ol,array,matrix\}));\n L:=seq(coB*nameB[ii,ii],ii=1..m);\n return \+ RC(x,y,linalg[diag](L))\n end if;\nend proc:" }}{PARA 258 "" 0 "" {TEXT -1 19 "\nNo. 22. Procedure " }{TEXT 303 8 "gradeinv" }{TEXT -1 133 " is the grade involution in the Clifford algebra,i.e., it reverse s signs of odd elements and leaves signs of even elements unchanged." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typ ical use: gradeinv(e1 + e1we2 - 4*e3we4); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 553 "gradeinv:=proc(a1::\{matrix,cliscalar,clibasmon,clim on,clipolynom\}) global _CLIENV;\noptions `Copyright (c) 1995-2009 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: December 20, 2008`;\n############################# ################\nif type(a1,matrix) then return map(procname,a1) end \+ if;\n#if not assigned(_CLIENV) then _CLIENV[_QDEF_PREFACTOR]:=-1 end \+ if;\nif type(a1,clibasmon) then return (_CLIENV[_QDEF_PREFACTOR])^maxg rade(a1)*a1 \n else return clilinear(a1,procname) \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 23. Defi ne the " }{TEXT 304 5 "wedge" }{TEXT -1 1306 " product of any number o f Clifford polynomials. The infix form of this associative multiplica tion is `&w`. Thus, e1 &w e2 = wedge(e1, e2), etc. Via the procedure 'rmulm' described below, wedge multiplication may be applied to matri ces with entries in a Clifford algebra or in an exterior algebra.\n\nN ew feature: When the dimension of the vector space is known, either fr om the size of the matrix B or from the global parameter dim_V that ca n be set by the user, the output of the procedure does not include ter ms of grade higher than the dimension of the vector space in case symb olic indices are used. \n\nThe default value of this global variable i s 9 and it it set by the initialization file when Clifford is loaded. \n\nWhen the procedure is invoked, 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 value of dim_V. If again yes, a warning mes sage is issued by the procedure and the value of dim_V is reduced. If \+ the size of B is larger than the current value of dim_V, no warning me ssage is issued and the value of dim_V is increased to linalg[coldim] (B).\n\nThe warning message can be supressed by addign 'false' to a gl obal parameter _warnings_flag whose default value is set to true by th e Clifford initialization file." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 96 "Typical use: wedge(e1 + e2, e4 + e1we2) ; wedge(e2 + 2*e1, e3, e4); (e2 + 2*e1) &w (e3 + 2*); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3062 "wedge:=proc(a1::\{cliscalar,clibasmon,cli mon,clipolynom\},\n a2::\{cliscalar,clibasmon,climon,clipol ynom\}) \nlocal ii,kk,wedge2,pi,p1,p2,i1,i2,i12,n12,maxindexflag,expr, maxin;\nglobal dim_V,B,_warnings_flag;\noptions `Copyright (c) 1995-20 09 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nd escription `Last revised: December 20, 2008`;\n####################### ######################\nkk:='kk':\nif member(0,[args]) then return 0 \+ \nelif \n remove(type,\{args\},cliscalar)=\{\} then return product(a rgs[kk],kk=1..nargs)\nend if;\nif type(B,matrix) then\n if linalg[co ldim](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 red uced by 'wedge' to %g\\n\",dim_V);\n end if;\n elif linalg[c oldim](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 typ e(dim_V,posint) then\n error \"value of dim_V must be a positive int eger between 1 and 9, inclusive, but current value of dim_V is %1\",di m_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 max indexflag:=evalb(maxin > dim_V);\nelse maxindexflag:=false:\nend if:\n if maxindexflag then \n error \"argument(s) contain(s) index larger \+ then current value of dim_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 d im_V;\n i1:=\{op(Clifford:-extract(args[1]))\};n1:=nops(i1):\n i2:=\{o p(Clifford:-extract(args[2]))\};n2:=nops(i2):\n if args[1]=Id then \n \+ if n2>dim_V then return 0 else return args[2] end if;\n end if;\n i f args[2]=Id then \n if n1>dim_V then return 0 else return args[1] \+ end if;\n end if;\n i1:=\{op(Clifford:-extract(args[1]))\};\n i2:= \{op(Clifford:-extract(args[2]))\};\n i12:=i1 union i2;\n s12:= re move(member,i12,\{`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`\}):\n symbinde xflag:=evalb(not s12=\{\}):\n if i1 intersect i2 <> \{\} then return 0 end if;\n if symbindexflag and nops(i1)+nops(i2) > dim_V then ret urn 0 end if;\nreturn reorder(cat(args[1],\"w\",args[2]));\nend proc: \n################\nif nargs=1 then return args\nelif nargs=2 then p1: =displayid(a1):\n p2:=displayid(a2):\n \+ expr:=clibilinear(p1,p2,wedge2);\n if hastype(expr ,trig) then \n return clicollect(map(combine,clico llect(expr),trig))\n else \n retu rn reorder(expr)\n end if;\nelse expr:=procname(procn ame(a1,a2),args[3..nargs]):\n if hastype(expr,trig) then \n \+ return clicollect(map(combine,clicollect(expr),trig))\n else \n \+ return reorder(expr)\n end if;\nend if;\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 269 29 "No. 24. Ampersand version of " }{TEXT 307 5 "wedge" }{TEXT 308 38 ". (Has been moved to Clifford:-setup)\n" }}{PARA 0 "" 0 "" {TEXT 260 18 "No. 25. Procedure " }{TEXT 305 8 "perm sign" }{TEXT 306 118 " computes sign of a permutation that sorts a lis t of indices.\n\nTypical use: permsign([1,3,2]); permsign([j,1,i,k,2]) ;\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 881 "permsign:=proc(L::list) loc al newbas,ss,a,n12,s12,L1,L2,N,f,dummy_set,K,x;\noptions `Copyright (c ) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reser ved.`;\ndescription `Last revised: December 20, 2008`;\n############## ###############################\nL1:=L:\nN:=nops(L1):\nif N=1 then ret urn 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)),op(sort(s12))];\n################## new\nf:=pro c() end proc:\nfor ss from 1 to N do\n f(L2[ss]):=L1[ss];\nend do;\nd ummy_set:=convert(L1,set);\nK:=0:\nwhile dummy_set <> \{\} do\n a:=du mmy_set[1]:\n dummy_set:=dummy_set[2..-1];\n x:=a:\n while f(x)<>a \+ do\n x:=f(x);\n dummy_set:=dummy_set minus \{x\};\n K:= K+1;\n end do:\nend do;\n#newbas:=cat(e.(op(L2[1..-2])).w,e,L2[-1]): \n#return ((-1)^K*newbas);\nreturn (-1)^K;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 18 "No. 26. Procedure " }{TEXT 309 7 "cmulNUM" }{TEXT -1 148 " calculates Clifford product between any two Clifford monomial s using the recursivelyChevalley'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 an y element in the algebra, wedge(x,u) = x &w u denotes the wedge or ext erior product between x and u, and LC(x, u) denotes the left contract ion of u by x. This procedure is now bilinear in both arguments. The \+ infix form is available e.g., e1 &c e2. This procedure works in Cliff ord algebras in dimensions up to and including 9. Multiplication of m atrices with entries in a Clifford algebra can be done with a procedur e 'rmulm' described below." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 128 "This procedure requires third argument of ty pe name or a numeric multiple of a name. Then it computes Clifford pro duct in Cl(K)." }}{PARA 258 "" 0 "" {TEXT -1 221 "\nThis version can t ake index as a way of passing a parameter. The index could be of type `&*`(numeric,\{name,symbol,array,matrix\}) or of type \{name,symbol, array,matrix\}.\n\nWhen the bilinear form B is symbolic, use cmulRS." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 264 55 "Typi cal use: cmulNUM(e1,e3we4,B); cmulNUM(e1,e3we4,-K);" }{TEXT 265 3 " \+ \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2254 "cmulNUM:=proc(a1,a2,lname) \+ \n local L,N,L2,x,x1,x2,S,i,ii,T1,T2,K,p1,p2,coB,nameB,a12;global B: \n options `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: December 20, 2008`;\n#############################################\n###This is additional code for Maple 6 version:\n############################### ##############\nif hastype(\{a1,a2\},cliprod) then\n a12:=map(Cliplu s:-clieval,[a1,a2]);\n return Cliplus:-cliexpand(clibilinear(a12[1], a12[2],procname,lname))\nend if: \n################################### ###################################################\n### old name cmul 2B: this procedure computes recursively Clifford product of any two # \n### cliscalars, clibasmons, climons, and clipolynoms in Clifford alg ebras Cl(lname) #\n################################################## ####################################\n if nargs<>3 then error \"exact ly three arguments are needed\" end if:\n if has(0,map(simplify,[a1,a 2])) then return 0 end if;\n if a2=`Id` then return a1 end if:\n if \+ a1=`Id` then return a2 end if:\n L:=Clifford:-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,`&*`(numer ic,\{name,symbol,array,matrix\})) then\n coB:=op(select(type,\{op( lname)\},numeric));\n nameB:=op(select(type,\{op(lname)\},name)); \n else\n error \"third argument is of unexpected type\"\n end i f;\n ################\n if N=0 then return coeff(a1,Id)*a2\n elif N =1 then\n L2:=Clifford:-extract(a2,'integers'):\n return reorder (simplify(makeclibasmon([L[1],op(L2)])\n +add((-1)^(i-1)*coB*nameB [L[1],L2[i]]*makeclibasmon(subs(L2[i]=NULL,L2)),i=1..nops(L2))))\n el if N=2 then\n x1:=substring(a1,1..2):x2:=substring(a1,4..5);\n p 2:=procname(x2,a2,lname):\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:=substring(a1,1..(3*N-4));\n p2:=procname(x,a2,lname):\n S :=clibilinear(p1,p2,procname,lname)\n -add((-1)^(i)*coB*nameB[L[- i],L[-1]]*\nprocname(makeclibasmon(subs(L[-i]=NULL,L[1..-2])),a2,lname ),i=2..N); \n return reorder(simplify(S))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 266 19 "No. 27. Procedure " }{TEXT 310 6 "cmulRS" }{TEXT 311 114 " computes Clifford product using Rota-Stein cliffordization t echnique. It can accept now -K in place of the name.\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 4903 "cmulRS:=proc(a1,a2,lname)\nlocal max_grade,L 1,N1,L2,N2,genPS,fun1,fun2,srt,cup,pList1,PN1,\n pList2,PN2,pSgn1 ,pSgn2,a,i,j,m,n,res,pos1,pos2,F1,F2,coB,nameB,a12;\noptions `Copyrigh t (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: December 20, 2008`;\n########## ###################################\n###This is additional code for Ma ple 6 version:\n#############################################\nif hast ype(\{a1,a2\},cliprod) then\n a12:=map(Cliplus:-clieval,[a1,a2]);\n \+ return Cliplus:-cliexpand(clibilinear(a12[1],a12[2],procname,lname)) \nend if: \n########################################################## ################################\n### This procedure computes Clifford product of any two cliscalars, clibasmons, climons, #\n### and clipol ynoms in Clifford algebras Cl(lname) using Rota-Sten cliffordization \+ #\n### Procedure cmulRS modified by Rafal to accept -K, or -B for lname. #\n######################################## ##################################################\n if nargs<>3 then error \"exactly three arguments are needed\" end if:\n if has(0,map( simplify,[a1,a2])) then return 0 end if;\n if a1 = `Id` then return a 2 end if;\n if a2 = `Id` then return a1 end if;\n ################\n ##### The following will allow for lname to be -B, for example:\n i f type(lname,\{name,symbol,array,matrix\}) then\n coB,nameB:=1,lna me:\n elif type(lname,`&*`(numeric,\{name,symbol,array,matrix\})) the n\n coB:=op(select(type,\{op(lname)\},numeric));\n nameB:=op(s elect(type,\{op(lname)\},name));\n else\n error \"third argument \+ is of unexpected type\"\n end if;\n ################\n L1:=Clifford :-extract(a1,'integers');\n N1:=nops(L1);\n L2:=Clifford:-extract(a2 ,'integers');\n N2:=nops(L2);\n if N1=1 then \n return reorder(si mplify(makeclibasmon([L1[1],op(L2)])\n +add((-1)^(i-1)*coB*nameB[L1 [1],L2[i]]*makeclibasmon(subs(L2[i]=NULL,L2)),i=1..N2)))\n end if;\n \+ if N2=1 then \n return reorder(simplify(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 se t of 1..N, option remember\n genPS:=proc(N)\n local a,i,plst;\n \+ option remember; \n a:=[seq(i,i=1..N)]:\n plst:=[a]:\n for i in a do\n plst:=[op(subs(i=NULL,plst)),op(plst)]:\n end do:\n end proc:\n#### prepare combinatorics for L1:\n fun1:=proc(a1) a1 e nd 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# p List1:=[a]:\n# for i in a do\n# pList1 := [op(subs(i = NULL,pList1 )), op(pList1)]:\n# end do:\n####\npList1:=genPS(N1); \n PN1:=nops( pList1)+1; ## added 1 here\n pList1:=sort(pList1,(a,b)->evalb(nops(a )<=nops(b)));\n pSgn1 :=[seq((-1)^(add(pList1[i][m]-m,m=1..nops(pList 1[i]))),i=1..PN1-1)];\n#### prepare combinatorics for L2:\n fun2:=pro c(a2) a2 end proc:\n for i from 1 to N2 do\n fun2(i):=L2[i];\n en d do:\n#### here is the old code for the poweset \n# a:=[seq(i,i=1..N 2)]:\n# pList2:=[a]:\n# for i in a do\n# pList2 := [op(subs(i = N ULL,pList2)), op(pList2)]:\n# end do:\n####\npList2:=genPS(N2);\n PN 2:=nops(pList2)+1; ## added 1 here\n pList2:=sort(pList2,(a,b)->eval b(nops(a)<=nops(b)));\n pSgn2:=[seq((-1)^(add(pList2[i][m]-m,m=1..nop s(pList2[i]))),i=1..PN2-1)];\n#### cup tangle of the rota-stein sausag e tangle\n cup:=proc(lst1,lst2,coB,nameB)\n local i;\n if nops( lst1)<>nops(lst2) then return 0 end if;\n if lst1=[] then return 1 \+ end if;\n if nops(lst1)=1 then return coB*nameB[lst1[1],lst2[1]] en d if;\n add((-1)^(i-1)*coB*nameB[lst1[-1],lst2[i]]*cup(lst1[1..-2], subs(lst2[i]=NULL,lst2),coB,nameB)\n \+ ,i=1..nops(lst2))\n end proc:\n########## ###################################################################### ### \n## Rota-Stein Tangle : cliffordization \+ #\n## compose only such terms which are potentiall y 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 f rom 0 to N1 do # for all j-vectors of pList1\n F1:=N1!/((N1-j)!*j!); \n pos2:=0:\n for i from 0 to min(N2,max_grade-j) do # for all i-ve ctors of pList2\n # which do \+ not exceed max_grade (others are zero)\n F2:=N2!/((N2-i)!*i!);\n f or n from 1 to F1 do\n for m from 1 to F2 do \n res:=res+\n \+ pSgn1[pos1+n]*pSgn2[pos2+m]*\n cup(map(fun1,pList1[PN1-pos 1-n]),map(fun2,pList2[pos2+m]),coB,nameB)*\n makeclibasmon([op (map(fun1,pList1[pos1+n])),op(map(fun2,pList2[PN2-pos2-m]))])\n \+ end do:\n end do:\n pos2:=pos2+F2;\n end do:\n pos1:=pos1+ F1;\n end do: \nreturn reorder(res); ## note that cmulRS INCLUDES alr eady reorder !!\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 267 19 "No. 28. \+ Procedure " }{TEXT 312 7 "cmulgen" }{TEXT 313 47 " is just a place ho lder for a Clifford product." }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 558 "cmulgen:=proc() global _default_Clifford_product,_wa rnings_flag;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: \+ December 20, 2008`;\n#############################################\nif _default_Clifford_product <> 'cmulgen' then\n return _default_Cliff ord_product(args)\nelse \n if _warnings_flag then\n WARNING(\"to a ssign Clifford product, execute 'useproduct' with argument cmulRS, cmu lNUM, or cmul_user_defined first\");\n end if;\n return 'cmulgen' (args);\n end if; \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 268 25 "No. 2 9. Wrapper function " }{TEXT 314 4 "cmul" }{TEXT 315 90 " for the Clif ford product given by cmulNUM, cmulRS, or other procedure such as 'cmu lgen'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1379 "cmul:=proc() local ln ame;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n#############################################\n if type( op(procname),procedure) then\n lname:=`B`;\n else\n lname:=op(p rocname);\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 ma kes no difference whether cmulgen or #\n### _default_Clifford_product \+ is used in the following. # ######################################### #################\n return clicollect(clibilinear(eval(args[1]),eval( args[2]),cmulgen,lname)); \n end if;\n###### <=== do NOT use 'procnam e' in the next line this will not work\n############################## ############################\n### Speed-wise it makes no difference wh ether cmulgen or #\n### _default_Clifford_product is used in the follo wing. # ##########################################################\ni f not type(_default_Clifford_product,procedure) then \n error \"glob al variable _default_Clifford_product must be assigned a procedure so \+ that 'cmul' could proceed beyond this point. Sorry. For help see ?cmul .\" \nend if;\n return procname(clibilinear(eval(args[1]),eval(arg s[2]),cmulgen,lname),args[3..-1]); \nend proc:\n" }}{PARA 0 " " 0 "" {TEXT 270 29 "No. 30: Ampersand version of " }{TEXT 316 4 "cmul " }{TEXT 317 226 ". This version of `&c` correctly uses -K for index. \+ When K has been assigned a matrix, use\n&c[''K''](e1,e2) and &c[''-K'' ](e1,e2). Otherwise, use &c[K](e1,e2), &c[-K](e1,e2), or &c(e1,e2). (H as been moved to Clifford:-setup).\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2305 "`&m`:=proc() local NP,ARGS,coB,nameB,lname,decindex,flagdec;\n options `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: December 20, 2 008`;\n#############################################\n################ #######################\n### Works when &c[''K''] or &c[''-K''] is ent ered and K is a matrix\n#######################################\nflagd ec:=true:\nif type(op(procname),procedure) then\n if type([args],lis tlist) then\n if type(op(args),array) then\n WARNING(\"en close index in double quotes as in &c[''B''] or &c[''-B''] when B has \+ been assigned a matrix to avoid the following:\");\n return 'pr ocname(args)';\n end 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 f lagdec:=false:\n end if;\n#######################################\ndec index:=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(select(type,nameB,function));\n ARGS:=op(nameB); \n nameB:=op(0,nameB);\n else\n error \"unable to determin e 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:=ar gs;\n coB:=1:\n nameB:=`B`; #default name \nelse\n error \"canno t determine arguments and/or index from arguments\"\n end if;\nreturn \+ coB,nameB,[ARGS];\nend proc:\n#####################################\ni f flagdec then \n coB,nameB,ARGS:=decindex(args);\n lname:=coB*nam eB;\nend if;\nNP:=nops(ARGS);\nif member(0,ARGS) then return 0 end if; \nif NP <=1 then return op(ARGS) end if;\nreturn cmul[eval(lname)](op( ARGS)); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 271 18 "No. 31. Procedu re " }{TEXT 318 10 "useproduct" }{TEXT 319 80 " that allows user to se lect which procedure is used to compute Clifford product." }{TEXT 478 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1258 "useproduct:=proc(name:: \{symbol,name\})\nlocal wstr;\nglobal _default_Clifford_product; #,cmu lgen;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Decembe r 20, 2008`;\n#############################################\n######### ##########################################################\n###This pr ocedure uses global variable _default_Clifford_product #\n########### ######################################################## \nif not memb er(name,\{cmulRS,cmulNUM,cmulgen,cmul_user_defined\}) then \n WARNI NG(\"expecting one of the following Clifford products: cmulRS, cmulNUM , cmulgen, or cmul_user_defined\") \nend if;\nif member(name,\{cmul_us er_defined\}) and not type(name,procedure) then\n WARNING(\"no compu tations with cmul can be peformed yet since cmul_user_defined has not \+ been defined as procedure. Select cmulRS, cmulNUM, or a new procedure \+ as argument to useproduct.\");\n _default_Clifford_product:=name;\nr eturn NULL;\nend if;\n################################\n_default_Cliff ord_product:=name; #change value of _default_Clifford_product \n###### ##########################\nwstr:=cat(\"cmul will use \",name,\"; for \+ help see pages ?cmul, ?Clifford:-intro, or ?\",name);\nWARNING(wstr); \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 32. Procedure " } {TEXT 320 5 "cmulQ" }{TEXT -1 20 " and its infix form " }{TEXT 321 3 " &cQ" }{TEXT -1 514 " is a special version of '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 1424 "cmulQ:=proc() local ii,N,L,m,Sxy,symbxy,lname,coB,nameB;global B:\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: December \+ 20, 2008`;\n#############################################\n########### #########################\nif type(op(procname),procedure) then\n l name:=`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\}));\n Sxy:=map(op,map(Clifford:-extract,Sxy,'integers'));\nsymbxy:=remove(ty pe,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 maxi ndex=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:\n######### #######################\nif type(lname,\{name,symbol,array,matrix\}) t hen\n L:=seq(lname[ii,ii],ii=1..m);\n return cmul[linalg[diag](L)] (args);\nelif \n type(lname,`&*`(numeric,\{name,symbol,array,matrix \})) then\n coB:=op(select(type,\{op(lname)\},numeric));\n nameB:= op(select(type,\{op(lname)\},\{name,symbol,array,matrix\}));\n L:=se q(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 376 "scalarpart:=proc(a::\{clisca lar,clibasmon,climon,clipolynom\}) local a1,p; \noptions `Copyright (c ) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reser ved.`;\ndescription `Last revised: December 20, 2008`;\n############## ###############################\na1:=simplify(a):\nif type(a1,cliscala r) then return a1 end if;\np:=clicollect(a1):\nreturn coeff(p,Id);\nen d 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 597 "vecto rpart:=proc(a::\{cliscalar,clibasmon,climon,clipolynom\},a2::nonnegint ) \nlocal a1,p,K;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: December 20, 2008`;\n############################################ #\na1:=expand(simplify(a)): #expand is needed\nif maxgrade(a1) < a2 th en return 0 end if;\n K:=proc() if maxgrade(args[1])=a2 then true el se false end if end proc:\nif type(a1,`+`) then p:=select(K,a1) elif\n maxgrade(a1)<>a2 then p:=NULL else \n p:=a1 \nend if;\nif p=NULL \+ then return 0 else return p end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 36. Procedure " }{TEXT 326 4 "cexp" }{TEXT -1 236 " c omputes Clifford exponential of a Clifford number in Cl(B) up to the o rder specified by the second argument which is a nonnegative integer \+ n. It n = 0 then this procedure returns 'Id'. It can accept another ar gument 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 1360 "cexp:=proc(p::\{numeric ,cliscalar,clibasmon,climon,clipolynom\},N::nonnegint) \nlocal pp,k,an s,ans1,ans2,lname,coB,nameB;\noptions `Copyright (c) 1995-2009 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n################################# ############\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lnam e:=`B`: \nelif nargs=3 then\n if type(args[3],\{name,symbol,matrix, array\}) then\n coB:=1:\n nameB:=args[3];\n lname:=a rgs[3];\n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array \})) then\n coB:=op(select(type,\{op(args[3])\},numeric));\n \+ nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=arg s[3]:\n else \n error \"wrong type of third argument in cexp. See ?cexp for more help.\" \n end if;\nelse\n error \"two or thr ee 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:=scalarpart(p);\n return ((add(pp^k/k!,k=0..N)*Id)) \nend if;\npp:=clisort(displayid(p)):\nif N=0 then return Id \n eli f 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](((ans 1-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 i n Cl(Q) up to the order specified by the second argument which is a n onnegative 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 "Typi cal use: cexpQ(e1we2*t, 3); or cexpQ((e1 + 2*e1we2)*t, 4);\n \+ cexpQ(e1we2*t, 3,K); or cexpQ((e1 + 2*e1we2)*t, 4,K);\n \+ cexpQ(Id+2*e1we3,4); or cexpQ(e1 + 2*e1we2, 4,-K);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1374 "cexpQ:=proc(p::\{numeric,clis calar,clibasmon,climon,clipolynom\},N::nonnegint) \nlocal pp,k,ans,ans 1,ans2,lname,coB,nameB;\noptions `Copyright (c) 1995-2009 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: December 20, 2008`;\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(select(type,\{op(args[3])\},numeric));\n na meB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]: \n else \n error \"wrong type of third argument in cexpQ. See ?cexpQ for more help.\" \n end if;\nelse\n error \"two or three \+ arguments expected in cexpQ. See ?cexpQ for more help.\"\nend if;\n### #############################\nk:='k':\nif type(p,\{numeric,cliscalar \}) then return (add(p^k/k!,k=0..N)) end if;\nif evalb(vectorpart(p,0) =p) then \n pp:=scalarpart(p);\n return add(pp^k/k!,k=0..N)*Id \ne nd if;\npp:=clisort(displayid(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:=cexpQ(pp,N-2,lname);\n ans:=ans1+cmulQ[lname] (((ans1-ans2)*(N-1)!),pp)/N!;\n return ans;\nend if;\nend proc :\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 38. Procedure " }{TEXT 328 4 "wexp" }{TEXT -1 168 " computes exterior exponential of a Clifford n umber u up to the order specified by the second argument which is a n onnegative 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 611 "wexp:= pr oc(p::\{cliscalar,clibasmon,climon,clipolynom\},N::nonnegative) \nloca l pp,power,cu,i;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revis ed: December 20, 2008`;\n############################################# \n if nargs<>2 then 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 ret urn 1+clisort(pp) end if;\n power:=pp;\n cu:=1+pp;\n for i from 2 t o N do\n power:=wedge(power,pp);\n cu:=cu + power/i!;\n end d o;\n return subs(Id=1,clicollect(clisort(cu)));\n end proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 39. Procedure " }{TEXT 329 9 "rever sion" }{TEXT -1 411 " calculates reversion in the Clifford algebra. It is linear in its argument and it is always a Clifford algebra anti-au tomorphism. When the antisymmetric part of B is not zero, 'reversion' does not preserve the multilinear structure of the algebra because it mixes grades, i.e., it does not preserve the gradation of the exterio r 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 "Typical use: reversion(2*e1we2 + 4*Id - e3we4we5); \n" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 2640 "reversion:=proc(a1::\{cliscalar, clibasmon,climon,clipolynom,matrix\}) \n local ind,expr,wtp, ptw,lname,flagindexed;\n global _scalartypes,B;\noptions `Co pyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: December 20, 2008`;\n#### #########################################\nif hastype([args[1]],clipro d) then \n error \"in order to handle 'type/cliprod', load in packag e Cliplus\" \n end if;\n############################\nif type(a1,clisc alar) then return a1 end if;\n############################\nif nargs=1 then\n lname:=`B`;\n flagindexed:=false:\nelif nargs=2 and type (args[2],\{symbol,name,array,matrix,`&*`(algebraic,name)\}) then\n \+ lname:=args[2];\n flagindexed:=true:\nelse error \"only one or two \+ arguments are expected\"\nend if;\n############################\n### A uxiliary function that converts wedges to Clifford products: wedge ->> Clifford product\n############################\nwtp:=proc(a1,lname) l ocal ind,i,arg,rdmon,eq1,ans; global _scalartypes; \nif type(a1,\{`+ `,`*`\}) then return (map(wtp,a1,lname)) \n elif type(a1,_scalartype s) 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:=Clifford:-extract(a1,'integers'):\ni:='i':\narg:=[seq(cat(e ,op(ind[i])),i=1..nops(ind))];\neq1:=cat(op(arg))=simplify(eval(cmul[l name](op(arg))));\nif a1=rdmon then ans:=simplify(solve(eq1,a1)) \n \+ else ans:=-simplify(solve(-eq1,-rdmon)) \nend if;\nif nops (ind) < 4 then return ans else return wtp(ans,lname) end if;\nend proc :\n############################\n### Auxiliary function that converts \+ Clifford products to wedge: Clifford products ->> wedge\n############# ###############\nptw:=proc(a1,lname) local i,arg,revarg; global _scala rtypes; \nif type(a1,\{`+`,`*`\}) then return (map(ptw,a1,lname)) \n \+ elif type(a1,_scalartypes) then return a1 \n elif type(a1,symbol) a nd SearchText(e,a1)=0 then return a1 \n elif type(a1,symbol) and len gth(a1)=2 then return a1 \n elif type(a1,symbol) and not member(leng th(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:=[seq(arg[nops(arg)-i],i=0..(nops(arg)-1))];\nreturn expan d(eval(cmul[lname](op(revarg))))\nend proc:\n######################### #####\n### Now the actual function:\n##############################\ni f type(a1,matrix) then return map(reversion,a1,lname) end if;\nexpr:=p tw(expand(wtp(a1,lname)),lname);\nexpr:=expand(displayid(expr)):\nretu rn clisort(expr)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 40 . Procedure " }{TEXT 330 11 "conjugation" }{TEXT -1 317 " calculates c onjugation in the Clifford algebra. It is linear in its argument. Not e that 'conjugation' is defined as a composition of 'reversion' and 'g radeinv'. Hence, it does not preserve the multivector gradation when \+ the antisymmetric part of B is non-zero. It can now accept optional a rgument 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 824 "co njugation:=proc(a1::algebraic) local lname;global B;\noptions `Copyrig ht (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: December 20, 2008`;\n######### ####################################\nif nargs=1 then\n lname:=`B`; \nelif nargs=2 and type(args[2],\n \{symbol,name,array,matrix,`&*` (numeric,\{symbol,name,array,matrix\})\}) then\n lname:=args[2];\ne lse error \"only one or two arguments are expected\"\nend if;\n####### ####################\nif type(a1,matrix) then return map(procname,a1,l name) elif\n type(a1,cliscalar) then return a1 elif\n type(a1,\{cl ibasmon,climon,clipolynom\}) then\n return eval(gradeinv(revers ion(a1,lname)))\nelse \n error \"wrong input type: input must be of \+ type cliscalar, clibasmon, climon, clipolynom, or 'matrix'\" \nend if; \nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 41. Procedure " }{TEXT 331 8 "c_conjug" }{TEXT -1 72 " calculates complex conjugate in a complexified Clifford algebra; thu s, " }}{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` i s the imaginary 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 698 "c_conjug:=proc(a1::algebraic) loca l ba,co,terms,t,i;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: December 20, 2008`;\n########################################### ##\nif type(a1,matrix) then return map(procname,a1) elif\n type(a1,c liscalar) then return conjugate(a1) elif\n type(a1,\{clibasmon,climo n,clipolynom\}) then\n t:='t':\n ba:=cliterms(a1);\n \+ co:=[coeffs(a1,ba,'t')];\n terms:=[t];i:='i':\n retu rn clisort(add(conjugate(co[i])*terms[i],i=1..nops(co)))\n else \ner ror \"wrong input type: input must be of type cliscalar, clibasmon, cl imon, clipolynom, or 'matrix'\" \nend if;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 18 "No. 42. Procedure " }{TEXT 332 6 "buildm" }{TEXT -1 863 " builds a matrix for the given element u of the Clifford algeb ra Cl(B) in the left- or right-regular representation, or under Lie or automorphism action with respect to an ordered basis specified by the user. The element p is entered as the first argument and the basis i n the form of a list is specified as the second argument, e.g., buildm (u, basis). It is also possible to specify options 'left', 'right', ' Lie', 'auto', 'false, and 'true'. For example, one can find the left-r egular representation of the algebra on itself or, when Cl(B) is simpl e and isomorphic to a ring of real matrices, one can find matrices rep resenting Clifford polynomials in a real basis of a minimal ideal. Ho wever, there are new procedures below specifically designed for findin g spinor representations of Clifford algebras in terms of real, comple x, and quaternionic matrices. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 270 "Typical use: \n\nbuildm(e1, [Id, e1, e 2, e1we2]); buildm(e1, [Id, e1, e2, e1we2], 'right'); buildm(e1, [Id, \+ e1, e2, e1we2], 'Lie');\nbuildm(e2, [Id, e1, e2, e1we2],'false'); buil dm(e1we2+e2, [Id, e1, e2, e1we2], 'true'); buildm(e1, [Id, e1, e2, e1w e2], 'Lie','false'); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2968 "bui ldm:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ a2::list(\{cliscalar,clibasmon,climon,clipolynom\}))\nlocal A,L,N,a11 ,xm,i,j,Lbasis,neq,vars,sys,sol,nontrivial,a33,flag;\noptions `Copyrig ht (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: December 20, 2008`;\n######### ####################################\nflag:=true:\nif nargs=2 then a33 :='left' end if;\nif nargs=3 then \n if member(args[3],\{'true','fal se'\}) then flag:=args[3];\n \+ a33:='left';\n elif member(args[3],\{'left','right','Lie','auto' \}) \n then a33:=args[3]\n els e error \"third optional argument must be 'left', 'right', 'Lie', 'aut o', 'true', 'false'\"\n end if; \nend if;\nif nargs=4 then\n if me mber(args[3],\{'left','right','Lie','auto'\}) and member(args[4],\{'fa lse','true'\}) then\n a33:=args[3]; \n flag:=args[4]; \n else \n error \"third optional argument must be 'left', 'rig ht', 'Lie', 'auto', and the fourth optional argument must be 'false' o r 'true'\"\n end if;\nend if;\nif nargs>4 then error \"too many argu ments. See ?buildm for more help.\" end if;\n######################### ########################\nif flag then \nA:=linalg[genmatrix](args[2], cbasis(maxindex(args[2])));\nif linalg[rank](A) < nops(args[2]) then \+ \n error \"elements of the list %1 are linearly dependent. Apply 'fi ndbasis' to this list first.\",a2 \nend if;\nend if;\n###local procedu re\nnontrivial:=proc(S::\{set(\{relation,algebraic\}),list(\{relation, algebraic\})\}) \nlocal istrivial;\nprintlevel:=2:\nistrivial:=proc(x) if type(x,relation) then evalb(x) else evalb(x=0) end if end;\nremove (istrivial,S)\nend proc:\n### \nL:=a2:N:=nops(L):xm:=array(1..N,1..N): \nif a33='left' then \n for i from 1 to N do \n eq||i:=clico llect(expand(cmul(a1,L[i])-add(xm[j,i]*L[j],j=1..N))) \n end do;\ne lif a33='right' then \n for i from 1 to N do \n \+ eq||i:=clicollect(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:=clicollect(expand(cmul(L[i],a1)-cmul(a1,L[i])-add(xm[j,i]*L[j ],j=1..N)))\n end do;\nelif a33='auto' then\n a11:=cinv(a1):\n for i from 1 to N do \n eq||i:=clicollect (expand(cmul(cmul(a1,L[i]),a11)-add(xm[j,i]*L[j],j=1..N)))\n end d o;\nelse error \"third optional argument must be 'left', 'right', 'Lie ', or 'auto'\"\nend if;\n############################################# #############\nLbasis:=[op(`union` (seq(cliterms(L[i]),i=1..N)))];\nfo r i from 1 to 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(eval m(xm),set):sys:=map(op,\{entries(neq)\});\nsys:=nontrivial(sys): #elim inate trivial equations\nsol:=solve(sys,vars);\nif sol=NULL then \n \+ error \"no matrix 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 "findb asis" }{TEXT -1 680 " finds a basis in a linear vector space spanned b y a set of Clifford polynomials entered as a list. The procedure is u sed, for example, when finding a basis for a spinor space S considere d as a minimal left or right ideal in Cl(B) generated by a primitive i dempotent f. To speed up computations, it is advisable to a standard C lifford basis for Cl(B) in the form of a list of basis monomials as th e second argument. If only one list is specified, 'findbasis' determi nes a suitable Clifford basis itself but it takes twice as much time t hen since it creates a Clifford basis by using 'cbasis(maxindex)' wher e 'maxindex' is the maximum index found among the elements of the list ." }}{PARA 258 "" 0 "" {TEXT -1 69 "\nTypical use: findbasis([2*e1+e2, e2+e1we2,e1we2],[Id,e1,e2,e1we2]);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1478 "findbasis:=proc(a1,a2) local L,clibasis,M,i,m,r,v,S; \nglobal \+ _prolevel;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: De cember 20, 2008`;\n#############################################\nif e valb(_prolevel=false) then\n if nargs=1 and not (type(a1,list(\{clib asmon,climon,clipolynom\})) or \n type(a1,set(\{ clibasmon,climon,clipolynom\}))) then\nerror \"argument of type list/s et(\{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 2247 "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-2009 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`;\ndescription `Last revised: December 20, 200 8`;\n#############################################\nif not type(B,diag matrix) then \n error \"bilinear form B has not been assigned a matr ix or is not diagonal\" \nend if; \nif not _prolevel then\n if not t ype(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 n ot 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]))=gradei nv(f) then\n SBgens:=data[5]:\n if flag_left then SB:= [seq(cmulQ(g,f),g=SBgens)] else \n SB:=[seq( cmulQ(f,g),g=SBgens)] \n end if;\n return [SB,SBgens,a3 ];\n end if;\n end if;\nend if; \n#If can't use the shortcut , 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\}) t hen \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; \n else\n realdim:=4*ni; \n dimoverK:=ni \nend if;\ngens:=clida ta()[5]: #put elements from clidata()[5] first in L\nL:=remove(member, L,gens):\nL:=[op(gens),op(L)]:\nSB:=[f]:SBgens:=[Id]:cb:=remove(member ,L,[Id]); \nfor g in cb while nops(SB) < 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:=[o p(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 "Kfie ld" }{TEXT -1 340 " computes a basis for a field K. The field K is th e field of the spinor space S = Cl(B)f or S = fCl(B) of the given Clif ford algebra Cl(B). It is isomorphic to the reals, or to the complex es, or to the quaternions according to whether (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respectively (here [p,q] is the signature of B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 205 "Assuming that the bilinear form B has been defined, the \+ first argument of the procedure is expected to be 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 4633 "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-2009 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: December 20, 2008`;\n##### ########################################\n#### Local procedure needed \+ only in 'Kfield' ###\nT4:=proc() \nlocal gens,Kbasis,f,mi,clibas,cliba s2,x,y,z; global B;\nKbasis:=args[1];f:=Kbasis[1];mi:=max(op(map(maxin dex,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),op (clibas)];\nend if;\nclibas2:=[]:\nfor x in clibas do \n if evalb(c mul(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 remo ve(member,clibas2,[x,y]) do\n if member(cmul(x,f),\{Kbasis[2],-Kb asis[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 2865 "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-2009 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: De cember 20, 2008`;\n#############################################\nif n ot type(B,matrix) then \n error \"matrix must be assigned to B\" \ne nd if;\nif not _prolevel then\n if not type(a2,'idempotent') then \n error \"second argument must be an idempotent\" elif\n not mem ber(a4,\{'left','right',\"left\",\"right\"\}) then \n error \"the fourth argument must be 'left', or 'right'\"\n end if;\nend if;\nSB gens:=a1:f:=eval(a2):FBgens:=a3:\nif SBgens=FBgens then return [[f],[I d],a4] end if;\nif a4='left' or a4=\"left\" then flag_left:=true else \+ flag_left:=false end if;\ndata:=clidata():\nif _shortcut_in_spinorKbas is then\n if eval(f)=eval(data[4]) and SBgens=data[5] and FBgens= data[6] then\n SBKgens:=data[7];\n SBKbasis:=[]:\n g:=' g':\n if flag_left then SBKbasis:=[seq(cmulQ(g,f),g=SBKgens)]\n \+ else SBKbasis:=[seq(cmulQ(f,g),g=SBKgens)]\n end if; \n return [SBKbasis,SBKgens,a4];\n end if;\nend if; \n Kdim:=nops(FBgens):SB:=[]:\ng:='g':\nif flag_left then SB:=[seq(cmulQ( g,f),g=SBgens)] \n else SB:=[seq(cmulQ(f,g),g=SBgens)]\nen d if;\nif Kdim=1 then return [SB,SBgens,a4] end if;\nm:=max(op(map(max index,SBgens)));\nposs:=cbasis(m);\nSBKgens:=[Id]:\ng:='g':\nif flag_l eft then SB:=remove(member,SB,[seq(cmul(f,g),g=FBgens)])\n \+ else SB:=remove(member,SB,[seq(cmul(g,f),g=FBgens)])\nend if;\nposs:= remove(member,poss,FBgens);\nfor g in poss while nops(SB)>0 do\n if flag_left then \n for i from 1 to Kdim do p[i]:=cmul(g,f,FBgens [i]) end do;\n else \n for i from 1 to Kdim do p[i]:=cmul(FBg ens[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 fl ag[2,1]) and (flag[1,2] or flag[2,2]) then\n SB:=remove(membe r,SB,[p[1],-p[1],p[2],-p[2]]):\n SBKgens:=[op(SBKgens),g]\n \+ end if:\n else\n if (flag[1,1] or flag[2,1]) and \n \+ (flag[1,2] or flag[2,2]) and\n (flag[1,3] or flag[2,3]) and \n (flag[1,4] or flag[2,4])\n then\n SB:=remove(m ember,SB,[p[1],-p[1],p[2],-p[2],p[3],-p[3],p[4],-p[4]]):\n SBK gens:=[op(SBKgens),g]\n end if:\n end if;\n if flag[1,1] th en SBKbasis:=[op(SBKbasis),p[1]] else\n SBKbasis: =[op(SBKbasis),-p[1]] \n end if;\n end do;\ng:='g':\nif flag_lef t then SBKbasis:=[seq(cmul(g,f),g=SBKgens)] else\n SB Kbasis:=[seq(cmul(f,g),g=SBKgens)]\nend if;\nreturn [SBKbasis,SBKgens, a4]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 47. Procedure \+ " }{TEXT 337 10 "squaremodf" }{TEXT -1 390 " computes the square of a \+ basis element u in a left or right minimal ideal Cl(B)f or fCl(B) ente red as the first argument modulo a primitive idempotent f entered as the second argument. The procedure doesn't check whether f is primit ive or not. Thus, the procedure returns 1 or -1 depending whether cmu l(u,u) = f or cmul(u,u) = -f. The procedure returns 0 if u is a nilp otent 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 784 "squaremodf:=proc(a1::\{clibasmon,climon,clipolynom\} ,a2::idempotent) \nlocal p;global B;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndes cription `Last revised: December 20, 2008`;\n######################### ####################\nif nargs<>2 then \n error \"two arguments need ed of type clibasmon, or climon, or clipolynom, and 'idempotent'\" \ne nd if;\nif a1=a2 then return 1 elif\n not type(B,matrix) then error \+ \"matrix must be assigned to B\" \nend if;\np:=cmul(a1,a1):\nif expand (p-a2)=0 then return 1 elif\n expand(p+a2)=0 then return -1 elif\n \+ (p=0 or type(a1,nilpotent)) then return 0 else \n error \"ei ther element %1 is not a basis element or it does not belong to the sp inor 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 505 "RHnumber :=proc(a1::integer)\noptions `Copyright (c) 1995-2009 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: December 20, 2008`;\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 re turn 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 474 "clidata:=proc() lo cal a1,clidata2;global B;\noptions `Copyright (c) 1995-2009 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: December 20, 2008`;\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 Cl ifford algebra Cl_\{p,q\} try clidata([p,q]) or enter ?clidata for mor e help\");\n return ('procname(args)')\nend if;\n" }}{PARA 258 "" 0 "" {TEXT -1 76 "This is a data file that is read in when needed by the procedure 'clidata'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "clidata2 " }{TEXT -1 0 "" }{MPLTEXT 1 0 16601 ":=proc(a1::\{list(nonnegint),mat rix\})\nlocal SBgens,FBgens,SBKgens,p,q,l,ni,K,dimoverK,dimoverR,numfa ct,struct,primidemp;\nglobal B;\noptions `Copyright (c) 1995-2009 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`,remember; \ndescription `Last revised: December 20, 2008`;\n#################### #########################\n#K = field of spinor repesentation, it is R , C, or H depending on [p,q]\n#dimoverK = dimension of spinor represen tation over the field K\n#dimoverR = dimension of spinor representatio n over the reals R\n#numfact = number of idempotent factors in any pri mitive idempotent\n#SBgens = basis monomials generating Cl(Q)f and fCl (Q) over R\n#FBgens = basis monomials providing a basis for K\n#SBKgen s = 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 f orm 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 n args=0 then\n###new line instead of >>>not assigned(B)<<<\nif not type (B,matrix) then \n error \"matrix must be assigned to B\" else\n \+ return clidata(B)\nend if;\nend if; \nif type(args[1],list(nonnegint )) then p:=args[1][1]:q:=args[1][2]: \n elif type(args[1],matrix) th en \n p:=Bsignature(args)[1]; q:=Bsignature(args)[2] \n else \+ \n error \"wrong argument types in 'clidata'\" \n end if;\nif type(args[1],list(nonnegint)) and (p>9 or q>9) then\n error \"p and q must satisfy 0 <= p,q <= 9\" \nend if;\nl:=floor((p+q)/2);ni:=2^(l- 1);\nif member((p-q) mod 8,\{0,1,2\}) then \n K:='real'; dimoverR :=2*ni; dimoverK:=2*ni; \nelif member((p-q) mod 8,\{3,7\}) then \n \+ K:='complex'; dimoverR:=2*2*ni; dimoverK:=2*ni; else\n K:='quat ernionic'; dimoverR:=4*ni; dimoverK:=ni \nend if;\nnumfact:=q-RHnumber (q-p);\nif modp((p-q) = 1,4) then struct:='semisimple' \n else struc t:='simple' \nend if;\nprimidemp:=table():SBgens:=table():FBgens:=tabl e():SBKgens:=table():\n#########################>>>DATA<<<############ #####################\n#Real, simple (13 cases)\nprimidemp[[0,0]]:=Id; #real numbers\nSBgens[[0,0]]:=[Id];\nFBgens[[0,0]]:=[Id];\nSBKgens[[ 0,0]]:=SBgens[[0,0]];\n\nprimidemp[[1,1]]:=(1/2)*(Id+e1we2);\nSBgens[[ 1,1]]:=[Id,e1];\nFBgens[[1,1]]:=[Id];\nSBKgens[[1,1]]:=SBgens[[1,1]]; \n\nprimidemp[[2,0]]:=(1/2)*(Id+e1);\nSBgens[[2,0]]:=[Id,e2];\nFBgens[ [2,0]]:=[Id];\nSBKgens[[2,0]]:=SBgens[[2,0]];\n\nprimidemp[[2,2]]:=\n' 'cmulQ''((1/2)*(Id+e1we3),(1/2)*(Id+e2we4));\nSBgens[[2,2]]:=[Id,e1,e2 ,e1we2];\nFBgens[[2,2]]:=[Id];\nSBKgens[[2,2]]:=SBgens[[2,2]];\n\nprim idemp[[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\nprimi demp[[3,3]]:=\n''cmulQ''((1/2)*(Id+e1we4),(1/2)*(Id+e2we5),(1/2)*(Id+e 3we6));\nSBgens[[3,3]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\nFBg ens[[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));\nSBgens [[4,2]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\nFBgens[[4,2]]:=[Id ];\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));\nS Bgens[[4,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4,e1we 2we3,\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));\nSBgens [[5,3]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5,e2we3we4, \ne2we3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBgens[[5,3]]:=[Id];\nSBKg ens[[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)*(I d+e2we4we6we8));\nSBgens[[8,0]]:=[Id,e2,e3,e4,e5,e6,e7,e8,e2we3,e2we4, e2we5,e2we6,e2we7,\ne2we8,e3we8,e2we3we8];\nFBgens[[8,0]]:=[Id];\nSBKg ens[[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)*(I d+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+e1we2w e3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6),\n (1/2)*(Id+e3we 6we7));\nSBgens[[0,8]]:=\n[Id,e1,e2,e3,e4,e5,e6,e7,e8,e1we8,e2we8,e3we 8,e4we8,e5we8,e6we8,e7we8];\nFBgens[[0,8]]:=[Id];\nSBKgens[[0,8]]:=SBg ens[[0,8]];\n\n#Complex, simple (15 cases)\nprimidemp[[0,1]]:=Id; #co mplex numbers\nSBgens[[0,1]]:=[Id,e1];\nFBgens[[0,1]]:=[Id,e1];\nSBKge ns[[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,e 1];\n\nprimidemp[[3,0]]:=(1/2)*(Id+e1);\nSBgens[[3,0]]:=[Id,e2,e3,e2we 3];\nFBgens[[3,0]]:=[Id,e2we3];\nSBKgens[[3,0]]:=[Id,e2];\n\nprimidemp [[0,5]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5));\nSBgens [[0,5]]:=[Id,e1,e2,e3,e4,e5,e1we4,e1we5];\nFBgens[[0,5]]:=[Id,e3];\nSB Kgens[[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,e1we 3,e2we3,e1we2we3];\nFBgens[[2,3]]:=[Id,e3];\nSBKgens[[2,3]]:=[Id,e1,e2 ,e1we2];\n\nprimidemp[[4,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e4we 5));\nSBgens[[4,1]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\nFBgens [[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+e 1we7));\nSBgens[[1,6]]:=[Id,e1,e2,e3,e4,e5,e6,e1we2,e1we3,e1we4,e1we5, e1we6,e2we5, e2we6,e1we 2we5,e1we2we6]; \nFBgens[[1,6]]:=[Id,e4];\nSBKgens[[1,6]]:=[Id,e1,e2,e 5,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 e1we2we 3,e1we2we4,e1we3we4,e2we3we4,e1we2we3we4]; \nFBgens[[3,4]]:=[Id,e4];\n SBKgens[[3,4]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\n\nprimidemp [[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]; \n FBgens[[5,2]]:=[Id,e2we3];\nSBKgens[[5,2]]:=[Id,e2,e4,e5,e2we4,e2we5,e 4we5,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,e4, e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2we7,\n e4we6,e4we7,e 2we4we6,e2we4we7]; \nFBgens[[7,0]]:=[Id,e2we3];\nSBKgens[[7,0]]:=[Id,e 2,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,e8, e9,e1we8,e1we9,e2we8,e2we9,e3we8,e3we9,\n e4we8,e4we9,e5we8,e5we9,e6we 8,e6we9,e7we8,e7we9,e8we9,e1we8we9,\n e2we8we9,e3we8we9,e4we8we9,e5we8 we9,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+e3we4we 5),(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,e1 we6,e1we7,e2we3,\n e2we4,e2we5,e2we6,e2we7,e3we6,e3we7,e1we2we3,e1we2w e4,e1we2we5,\n e1we2we6,e1we2we7,e1we3we6,e1we3we7,e2we3we6,e2we3we7,e 1we2we3we6,\n e1we2we3we7];\nFBgens[[2,7]]:=[Id,e5];\nSBKgens[[2,7]]:= \n[Id,e1,e2,e3,e6,e1we2,e1we3,e1we6,e2we3,e2we6,e3we6,e1we2we3,e1we2we 6,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,e2 we4,e2we5,e3we4,\n e3we5,e4we5,e1we2we3,e1we2we4,e1we2we5,e1we3we4,e1w e3we5,e1we4we5,\n e2we3we4,e2we3we5,e2we4we5,e3we4we5,e1we2we3we4,e1we 2we3we5,\n e1we2we4we5,e1we3we4we5,e2we3we4we5,e1we2we3we4we5];\nFBgen s[[4,5]]:=[Id,e5];\nSBKgens[[4,5]]:=\n[Id,e1,e2,e3,e4,e1we2,e1we3,e1we 4,e2we3,e2we4,e3we4,e1we2we3,e1we2we4,\n e1we3we4,e2we3we4,e1we2we3we4 ];\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,e2we3we 4,e2we3we5,e2we3we6,e2we4we5,e2we4we6,e2we5we6,\n e3we4we5,e3we4we6,e3 we5we6,e4we5we6,e2we3we4we5,e2we3we4we6,\n e2we3we5we6,e2we4we5we6,e3w e4we5we6,e2we3we4we5we6];\nFBgens[[6,3]]:=[Id,e2we3];\nSBKgens[[6,3]]: =\n[Id,e2,e4,e5,e6,e2we4,e2we5,e2we6,e4we5,e4we6,e5we6,e2we4we5,e2we4w e6,\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,e2we3 ,e2we4,e2we5,e2we6,e2we7,e2we8,e3we8,\n e4we6,e4we7,e4we8,e5we8,e6we8, e7we8,e2we3we8,e2we4we6,e2we4we7,\n e2we4we8,e2we5we8,e2we6we8,e2we7we 8,e4we6we8,e4we7we8,e2we4we6we8,\n e2we4we7we8];\nFBgens[[8,1]]:=[Id,e 2we3];\nSBKgens[[8,1]]:=\n[Id,e2,e4,e6,e8,e2we4,e2we6,e2we8,e4we6,e4we 8,e6we8,e2we4we6,e2we4we8,\n e2we6we8,e4we6we8,e2we4we6we8];\n\n#Quate rnionic, simple (12 cases)\nprimidemp[[0,2]]:=Id; #quaternions\nSBgens [[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);\nSB gens[[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];\n FBgens[[4,0]]:=[Id,e2we3,e2we4,e3we4];\nSBKgens[[4,0]]:=[Id,e2];\n\npr imidemp[[1,5]]:=\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e1we6));\nSB gens[[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,e 1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4,\n e1we2 we3,e1we2we4,e1we3we4,e2we3we4,e1we2we3we4];\nFBgens[[2,4]]:=[Id,e3,e4 ,e3we4];\nSBKgens[[2,4]]:=[Id,e1,e2,e1we2];\n\nprimidemp[[5,1]]:=\n''c mulQ''((1/2)*(Id+e1),(1/2)*(Id+e5we6));\nSBgens[[5,1]]:=[Id,e2,e3,e4,e 5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5,\n e2we3we4,e2we3 we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBgens[[5,1]]:=[Id,e2we3,e2we4,e3 we4];\nSBKgens[[5,1]]:=[Id,e2,e5,e2we5];\n\nprimidemp[[6,0]]:=\n''cmul Q''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5));\nSBgens[[6,0]]:=[Id,e2,e3,e 4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we6,e4we6,\n e5we6,e2 we3we6,e2we4we6,e2we5we6];\nFBgens[[6,0]]:=[Id,e2we3,e3we5,e2we5];\nSB Kgens[[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,e2we5, \n e2we6,e3we6,e4we6,e5we6,e1we2we3,e1we2we4,e1we2we5,e1we2we6,e1we3we 6,\n e1we4we6,e1we5we6,e2we3we6,e2we4we6,e2we5we6,e1we2we3we6,e1we2we4 we6,\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''c mulQ''((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,e 3we4,\n e3we5,e4we5,e1we2we3,e1we2we4,e1we2we5,e1we3we4,e1we3we5,e1we4 we5,\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,e1we2 we3];\n\nprimidemp[[6,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e5we7), (1/2)*(Id+e6we8));\nSBgens[[6,2]]:=\n[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2 we5,e2we6,e3we4,e3we5,e3we6,e4we5,\n e4we6,e5we6,e2we3we4,e2we3we5,e2w e3we6,e2we4we5,e2we4we6,e2we5we6,\n e3we4we5,e3we4we6,e3we5we6,e4we5we 6,e2we3we4we5,e2we3we4we6,\n e2we3we5we6,e2we4we5we6,e3we4we5we6,e2we3 we4we5we6];\nFBgens[[6,2]]:=[Id,e2we3,e2we4,e3we4];\nSBKgens[[6,2]]:=[ Id,e2,e5,e6,e2we5,e2we6,e5we6,e2we5we6];\n\nprimidemp[[7,1]]:=\n''cmul Q''((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,e3we 7,e4we6,\n e4we7,e5we6,e5we7,e6we7,e2we3we6,e2we3we7,e2we4we6,e2we4we7 ,e2we5we6,\n e2we5we7,e2we6we7,e3we6we7,e4we6we7,e5we6we7,e2we3we6we7, e2we4we6we7,\n e2we5we6we7];\nFBgens[[7,1]]:=[Id,e2we3,e3we5,e2we5];\n SBKgens[[7,1]]:=[Id,e2,e6,e7,e2we6,e2we7,e6we7,e2we6we7];\n\n#Real, se mi-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\nprimide mp[[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\npr imidemp[[3,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we4),(1/2)*(Id+e 3we5));\nSBgens[[3,2]]:=[Id,e2,e3,e2we3];\nFBgens[[3,2]]:=[Id];\nSBKge ns[[3,2]]:=SBgens[[3,2]];\n\nprimidemp[[0,7]]:= ''cmulQ''((1/2)*(Id+e1 we2we3),(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''cmulQ' '((1/2)*(Id+e1),(1/2)*(Id+e2we5),(1/2)*(Id+e3we6),\n (1/2)*(I d+e4we7));\nSBgens[[4,3]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\n FBgens[[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+e2we3we6w e7),\n (1/2)*(Id+e2we3we8we9),(1/2)*(Id+e2we4we6we8));\nSBgen s[[9,0]]:=\n[Id,e2,e3,e4,e5,e6,e7,e8,e9,e2we3,e2we4,e2we5,e2we6,e2we7, 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, e2we 3we5,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+e2we3w e8we9),(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+e1we2 we3);\nSBgens[[0,3]]:=[Id,e1,e2,e3];\nFBgens[[0,3]]:=[Id,e1,e2,e1we2]; \nSBKgens[[0,3]]:=[Id];\n\nprimidemp[[1,4]]:=\n''cmulQ''((1/2)*(Id+e2w e3we4),(1/2)*(Id+e1we5));\nSBgens[[1,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3, 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));\nS Bgens[[2,5]]:=[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4,e1we5,\n \+ e2we3,e2we4,e2we5,e1we2we3,e1we2we4,e1we2we5];\nFBgens[[2,5]]:=[I d,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\nprimid emp[[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,e3we6 ,e3we7,e4we5,e4we6,e4we7,e2we3we4,e2we3we5,e2we3we6,\ne2we3we7,e2we4we 5,e2we4we6,e2we4we7,e3we4we5,e3we4we6,e3we4we7,\ne2we3we4we5,e2we3we4w e6,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,e2 we6,e2we7,e2we8,e2we9,e3we6,e3we7,\ne3we8,e3we9,e6we7,e6we8,e6we9,e2we 3we6,e2we3we7,e2we3we8,e2we3we9,e2we6we7,\ne2we6we8,e2we6we9,e3we6we7, e3we6we8,e3we6we9,e2we3we6we7,e2we3we6we8,\ne2we3we6we9];\nFBgens[[3,6 ]]:=[Id,e6we7,e7we9,e6we9];\nSBKgens[[3,6]]:=[Id,e2,e3,e6,e2we3,e2we6, 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'\nend p roc: #### <<< End of 'clidata'\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 53. Procedure " }{TEXT 340 10 "Bsignature" }{TEXT -1 313 " finds the \+ signature of the form B assuming that B is a diagonal matrix or a sym metric matrix. It returns a list L with two or three integers dependin g 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) in t he 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 1290 "Bsignature:=proc() local curB,Bdi ag,pos,neg,deg,i,L;global B;\noptions `Copyright (c) 1995-2009 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n################################# ############\nif nargs=0 then\n if not type(B,matrix) then\n \+ error \"square matric should be assigned to B first\"\n else curB:= B \n end if;\nelif nargs=1 then\n if not type(evalm(args[1]),mat rix) then\n error \"argument entered is not a matrix\"\n else curB:=evalm(args[1]) \n end if;\nelse error \"wrong number of arg uments. See ?Bsignature for more help.\" \nend if;\nBdiag:=diagonalize (evalm(curB-(curB-linalg[transpose](curB))/2));\nif not type(Bdiag,dia gmatrix) then \n error \"unable to diagonalize symmetric part of the input\"\nend if;\nL:=map(signum,[seq(Bdiag[i,i],i=1..linalg[coldim](B diag))]):\nif not type(L,list(integer)) then\n error \"unable to det ermine signs of expressions %1\",L\nend if;\npos:=0:neg:=0:deg:=0:\nfo r i from 1 to linalg[coldim](Bdiag) do\nif L[i]<>0 then\n if evalf(L [i])>0 then pos:=pos+1 elif\n evalf(L[i])<0 then neg:=neg+1 else \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,neg] \+ 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 when \+ Cl(Q) is simple.\nThe procedure " }{TEXT 341 11 "spinorKrepr" }{TEXT -1 183 " finds matrix representation of any Clifford polynomial in a m inimal left or right ideal in Cl(Q) generated by a primitive idempoten t f. The procedure is invoked with four arguments:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 69 "(1) the first argume nt is an algebraic expression of type clipolynom;" }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 210 "(2) the second argum ent is a list of generators of the minimal ideal S considered as a K-v ector space. For standard f equal to clidata()[4] these generators ar e stored under clidata()[6] for the given form B; " }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 241 "(3) the third argume nt is a list of basis elements spanning K. For standard f equal to cl idata()[4] these generators are stored under clidata()[5]. Matrices c omputed by 'spinorKrepr' will be expressed in terms of these basis ele ments 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' o r 'right' depending whether the ideal is left or right." }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 562 "When standard i nput is used, i.e., the second argument equals clidata()[7] and the th ird argument equals clidata()[5], the procedure tries to use previousl y computed matrices representing 1-vectors. These matrices are stored as .m files with the names 'matrealL.m', 'matcompL.m', 'matquatL.m' f or real, complex, and quaternionic matrices in the left-regular spinor representation. If the first argument entered belongs to Cl(Q) whose \+ 1-vector matrices have been previously computed, the procedure calls ' matKrepr' which makes use of these pre-computed matrices." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 470 "Typical us e: dim:=4:B:=linalg[diag](1,-1,-1,-1):clibasis:=cbasis(dim):data:=clid ata():\n f:=data[4]:\n \+ sbasis:=minimalideal(clibasis,f,'left');\n fb asis:=Kfield(sbasis,f);\n Kbasis:=spinorKbasis (sbasis[2],f,fbasis[2],'left');\n spinorKrepr(e 1,Kbasis[1],fbasis[2],'left');\n spinorKrepr(2* e1+Id-3*e1we2we3,Kbasis[1],fbasis[2],'left');\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5599 "spinorKrepr:=proc(a1::\{clibasmon,climon,clipolynom ,numeric\},\n a2::list(\{clibasmon,climon,clipolynom \}),\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,data,Kbas is,f,v,pqmod8,n,expr,flag_simple;\nglobal B,_prolevel,_shortcut_in_spi norKrepr,matrealL,matrealR,matcompL,matcompR,matquatL,matquatR;\noptio ns `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: December 20, 2008`; \n#############################################\nif not type(B,diagmat rix) then \n error \"bilinear form B must be defined as diagonal mat rix\" \nelse pq:=Bsignature() \nend if;\n############################# #####\nif pq[1]-pq[2]=1 mod 4 then flag_simple:=false else flag_simple :=true end if;\n##################################\nif maxindex(a1) > \+ linalg[coldim](B) then\n error \"maximum index %1 found in input is \+ greater than the size %2 of the current bilinear form B\", maxindex(a1 ),linalg[coldim](B) \nend if;\n##################################\nhba sis:=a2:FBgens:=a3:reprdim:=nops(hbasis):n:=nops(FBgens):\n########### #######################\nif member(a4,\{'left',\"left\"\}) then flag_l eft:=true elif\n member(a4,\{'right',\"right\"\}) then flag_left:=fa lse else\n error \"last argument expected to be 'left' or 'right' bu t received %1 instead\",a4\nend if; \n################################ ########################################\n#This procedure gives faithf ul representations when Cl(p,q) is simple\n#and unfaithful when Cl(p,q ) is semi-simple. In order to get faithful\n#representations in this l ast case, use 'matKrepr' or use this procedure\n#as shown in examples. \n#################################################################### ####\n#if flag_simple then\nif a1=Id then return linalg[diag](1$reprd im) 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 _sh ortcut_in_spinorKrepr then\n pqmod8:=(pq[1]-pq[2]) mod 8:\n if mem ber(pqmod8,\{0,1,2\}) and flag_left then \n #if not assigned(matr ealL) then readlib(matrealL) end if;\n pqsig:=map(op,[indices(ma trealL)]) \n elif member(pqmod8,\{0,1,2\}) and not flag_left then\n \+ #if not assigned(matrealR) then readlib(matrealR) end if;\n \+ pqsig:=map(op,[indices(matrealR)]) \n elif member(pqmod8,\{3,7\}) a nd flag_left then \n #if not assigned(matcompL) then readlib(matc ompL) end if;\n pqsig:=map(op,[indices(matcompL)]) \n elif mem ber(pqmod8,\{3,7\}) and not flag_left then\n #if not assigned(mat compR) then readlib(matcompR) end if;\n pqsig:=map(op,[indices(m atcompR)]) \n elif member(pqmod8,\{4,5,6\}) and flag_left then \n \+ #if not assigned(matquatL) then readlib(matquatL) end if;\n p qsig:=map(op,[indices(matquatL)]) \n elif member(pqmod8,\{4,5,6\}) a nd not flag_left then\n #if not assigned(matquatR) then readlib(m atquatR) end if;\n pqsig:=map(op,[indices(matquatR)]) \n end i f;\n#####################################\n if member(pq,pqsig) then \n data:=clidata(pq):f:=eval(eval(data[4])):\n g:='g': \n if flag_left then Kbasis:=[seq(cmulQ(g,f),g=data[7])] \+ \n else Kbasis:=[seq(cmulQ(f,g),g=data[7])] \n \+ end if; \n if hbasis=Kbasis then\n if FBgens=data[6] then return matKrepr(a1,a4) end if; \n end if;\n end if;\nend i f;\n#####################################\n#Continue finding the matri x\n#####################################\na:='a':j:='j':k:='k':\nif fl ag_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] * FB gens[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 matrix due i nput error: check if the last argument matches 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:\nM:=linalg[transpose](li nalg[stackmatrix](seq(eval(v[i]),i=1..reprdim)));\nreturn subs(Id=1,ev alm(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:=cliterm s(eq);\n eq:=clicollect(eq,terms);\n sys:=\{coeffs(eq,term s)\}:\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 fin d matrix due to input error: check if the last argument matches the on e previously used in 'spinorKbasis'\"\n end if; \n v[i]:=c onvert([seq(subs(sol,r[j]),j=1..reprdim)],vector);\n end do:\n###### ###################################################################### \n#The next line produces wrong results in some quat right cases:\n#M: =linalg[transpose](linalg[stackmatrix](seq(eval(v[i]),i=1..reprdim))); \n#################################################################### ########\nM:=linalg[stackmatrix](seq(eval(v[i]),i=1..reprdim));\nretur n 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 appl ied to the matrix entries. It takes three arguments or four arguments . If the fourth argument is used, it is either of type name/symbol/arr ay/matrix or a numeric multiple of such type, for example, K or -K. \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 90 "T o apply Clifford multiplication 'cmul[B]' to matrix entries enter one \+ of the following: " }}{PARA 258 "" 0 "" {TEXT -1 143 "rmulm(M1, M2, c mul); 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 'cmulQ[B]' t o 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,c mulQ,K);rmulm(M1,M2,cmulQ,-K);\n&cQm(M1, M2); &cQm[B](M1,M2);&cQm[K](M 1,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 possibly non- commutative multiplication `&r` to matrix entries enter one of the fol lowing:" }}{PARA 258 "" 0 "" {TEXT -1 37 "rmulm(M1, M2, `&r`); M1 & rm M2; " }}{PARA 258 "" 0 "" {TEXT -1 98 "\nTo apply standard commut ative scalar multiplication to matrix entries enter one of the followi ng:" }}{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 fol lows: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 89 "To apply quaternionic multiplication 'qmul' to matrix entries e nter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 72 "rmulm(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 + e2w e3, e3 + e4, e1 - e2, Id + e1we3]); \n\nM1 := linalg[matrix](2, 2, [I d + 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 7271 "rmulm:=proc(a1::\{list(matrix),dfmatr ix,matrix,clipolynom,cliscalar,clibasmon,climon\},\n a2::\{ list(matrix),dfmatrix,matrix,clipolynom,cliscalar,clibasmon,climon\}, \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,tail,o ut;\nglobal _prolevel, `&r`;\noptions `Copyright (c) 1995-2009 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n################################# ############\n################################\nif has(0,map(simplify, [a1,a2])) then return 0 end if;\n################################ \ni f 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,array\}) \+ then\n coB:=1:\n nameB:=args[4];\n lname:=args[4];\n elif type(eval(args[4]),`&*`(numeric,\{name,symbol,matrix,array\}) ) 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 rmul m\",args[4] \n end if;\nelse\n error \"three or four arguments ex pected in rmulm\"\nend if;\n################################\ntail:=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 i f; \n################################\nif type(a1,matri x) and not type(a1,\{dfmatrix,climatrix,cliscalar\}) and \n type(a 2,matrix) and not type(a2,\{dfmatrix,climatrix,cliscalar\})\nthen \n \+ _prolevel:=reset_prolevel:\n return evalm(a1 &* a2) \n end if; \n################################\nif type(a1,list(matrix)) and type( a2,list(matrix)) then \n if nops(a1)<>nops(a2) then error \"received lists of unequal lengths\" \n else\n i:='i':\n _prolevel: =reset_prolevel:\n return [seq(procname(a1[i],a2[i],tail),i=1..no ps(a1))]\n end if;\nend if;\n################################\nif ty pe(a1,dfmatrix) and type(a2,dfmatrix) then\n return cdfmatrix(procna me(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(pr ocname,a1,ddfmatrix(a2),tail),dfmatrix))\n end if\nend if;\n######## ########################\nif type(a2,\{clipolynom,cliscalar,clibasmon, climon\}) then \n if type(a1,list(matrix)) then return map(procname, args) \n elif type(a1,dfmatrix) then \n return subs(Id=1,conv ert(map(procname,ddfmatrix(a1),a2,tail),dfmatrix))\n end if\nend if; \n################################\n#if not member(a3,\{`&*`,`&r`,Clip lus:-climul,cmul,cmulQ,wedge,qmul,Octonion:-omul\}) then \n# error \+ \"third argument must be one of the following: cmul, cmulQ, wedge, qmu l, omul, &*, &r but received %1 instead\",a3 #\n#end if;\n############ ####################\nif member(a3,\{`&*`\}) and \n (type(a1,\{cliba smon,climon,clipolynom,climatrix\}) or\n type(a2,\{clibasmon,climon ,clipolynom,climatrix\})) then\nerror \"it makes no sense to apply com mutative multiplication &* to non-commuting elements %1 and %2\",a1,a2 \nend if;\n################################\nar1:=evalm(a1):ar2:=eval m(a2):\nif not type(a1,matrix) and type(ar1,matrix) then \n _pro level:=reset_prolevel: \n return procname(ar1,a2,tail) \nend i f;\nif not type(a2,matrix) and type(ar2,matrix) then \n _proleve l:=reset_prolevel:\n return procname(a1,ar2,tail) \nend if;\n### ###################################################################### ###########\n##If both inputs are of type clipolynom, climon, or cliba smon do the following:\n############################################## ######################################\nif (type(evalm(a1),\{clibasmon ,climon,clipolynom\}) \n and \n type(evalm(a2),\{clibasmon,climo n,clipolynom\}))\nthen \n if member(a3,\{Cliplus:-climul,cmul,cmulQ \}) then\n _prolevel:=reset_prolevel: \n return simplify(r eorder(a3[lname](a1,a2)))\n elif \n member(a3,\{wedge,qmul,om ul\}) then\n _prolevel:=reset_prolevel:\n if _warnings_flag \+ and nargs=4 then\n WARNING(sprintf(\"ignoring fourth argument \+ %a\",lname))\n end if; \n #return simplify(reorder(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,climon,clipo lynom,cliscalar\}) \n and \n type(a2,matrix)\n then \n if me mber(a3,\{qmul\}) then \n m2:=map(eval,a2) \n else \n \+ m2:=a2 \n end if;\n L:=map(displayid,convert(m2,'mlist'));\n \+ newL:=[]:\n for i from 1 to nops(L) do newL:=[op(newL),a3[lname](a 1,L[i])] end do;\n if not member(a3,\{qmul\}) then\n _prolevel: =reset_prolevel: \n return map(displayid,map(simplify,linalg[ma trix](linalg[rowdim](a2),linalg[coldim](a2),newL)))\n else \n _ prolevel:=reset_prolevel: \n return map(simplify,linalg[matrix] (linalg[rowdim](a2),linalg[coldim](a2),newL))\nend if:\nend if: \n#### ###################################\n#a2 is a polynomial and a1 is a m atrix\n#######################################\nif type(evalm(a2),\{cl ibasmon,climon,clipolynom,cliscalar\}) \nand \n type(a1,matrix) \n \+ then \n if member(a3,\{qmul\}) then \n m1:=map(eval,a1) \n else \n m1:=a1 \n end if;\n L:=map(displayid,conve rt(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[matrix](li nalg[rowdim](a1),linalg[coldim](a1),newL))\nelse\n _prolevel:=reset_ prolevel: \n return map(simplify,linalg[matrix](linalg[rowdim](a1),l inalg[coldim](a1),newL))\nend if:\nend if: \n######################### #############################\n##If both inputs are of type matrix, do the following:\n##################################################### #\nif member(a3,\{qmul\}) then \n m1:=evalm(map(eval,a1));m2:=evalm(m ap(eval,a2))\nelse \n m1:=evalm(a1);m2:=evalm(a2); \nend if;\nm1:=dis playid(m1):m2:=displayid(m2):\nr1:=linalg[rowdim](m1):r2:=linalg[rowdi m](m2):\nc1:=linalg[coldim](m1):c2:=linalg[coldim](m2):\nif c1 <> r2 t hen \n error \"matrices have incompatible dimensions and cannot be m ultiplied\" \nend if;\nM:=linalg[matrix](r1,c2,[]);\nk:='k':\nfor i fr om 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[ln ame](m1[i,k],m2[k,j]),k=1..c1)) \nend if;\nod end do;\n_prolevel:=rese t_prolevel:\nif member(a3,\{Cliplus:-climul,cmul,cmulQ,wedge\}) then \+ \n return subs(Id=1,map(reorder,map(simplify,evalm(M)))) else\n re turn subs(Id=1,map(simplify,evalm(M))) \nend if;\nif 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, wedge, qmul, omul, &*, &r but received %1 instead\",a3 end if;\nretur n ;\nend proc:" }}{PARA 0 "" 0 "" {TEXT 261 9 "\nNo. 53: " }{TEXT 343 5 "`&cm`" }{TEXT 344 333 " denotes multiplication of matrices when Cli fford 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. Howeve r, when K has been assigned a matrix, put K between double quotes as i n &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 "No. 54: " } {TEXT 345 6 "`&cQm`" }{TEXT 346 416 " denotes multiplication of matric es when Clifford product of Cl(Q) is applied to matrix entries. One ca n use index as in &cQm[K](p1,p2), or &cQm[-K](p1,p2) provided index ha s not been assigned a matrix. If K has been assigned a matrix, put K b etween 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(Ha s 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 m ultiplication of matrices when wedge/exterior product is applied to ma trix entries:\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT 262 8 "No. 56: " }{TEXT 349 5 "`&qm`" }{TEXT 350 127 " denote s multiplication of matrices when quaternion product is applied to mat rix 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 octonionic multiplica tion is applied to the matrix entries.\n(Has been moved to Clifford:-s etup).\n" }}{PARA 0 "" 0 "" {TEXT 263 8 "No. 58: " }{TEXT 353 5 "`&rm` " }{TEXT 354 217 " denotes multiplication of matrices when a generic a ssociative but possibly not commutative `&r` product is applied to mat rix 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 m oved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 59. \+ Procedure " }{TEXT 355 8 "matKrepr" }{TEXT -1 261 " uses previously co mputed matrices of basis 1-vectors to find a matrix representation in \+ a minimal left or right ideal of any Clifford polynomial in the given \+ Clifford algebra Cl(Q). Depending on the signature [p,q] of the quadr atic 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; \n complex if (p - q) mod 8 is 3 or 7; \nquaternionic if (p - q) mod 8 i s 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 'spinorKrepr' in minimal left i deals and stored in a form of a table called 'matrealL' in Maple libra ry. The indices of the table are given by the signature [p,q]. To see \+ matrices in a specific signature [p,q], enter" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">matrealL([p,q]);" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 69 "(assu ming, of course, that the matrices for this signature are real)." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 359 "Simi larly for complex matrices in dimensions from 3 to 7 which are stored \+ in the file 'matcompL.m' and for quaternionic matrices in dimensions f rom 2 to 8 which are stored in the file 'matquatL.m'.\n\nSimilarly for matrices representing basis 1-vectors in right minimal ideals; in thi s case corresponding files are: 'matrealR.m', 'matcompR.m', and 'matqu atR.m'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 316 "Matrices representing Clifford polynomials are generally compu ted with 'matKrepr' much faster than with 'spinorKrepr' because the fo rmer is a linear procedure that uses matrix multiplication 'rmulm' to \+ compute matrices representing basis monomials.\n\nNOTE: This procedure can now handle semi-simple Clifford algebras." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 13 "Typical use: " }}{PARA 258 "" 0 "" {TEXT -1 92 "to see matrices representing 1-vectors in a l eft 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 representing a Cliffo rd polynomial p for the current B in a left minimal ideal enter:\n" }} {PARA 258 "" 0 "" {TEXT -1 36 ">matKrepr(p); \n>matKrepr(p,'left');\n " }}{PARA 0 "" 0 "" {TEXT 256 313 "to find a matrix representing a Cli fford polynomial p for the current B in a right minimal ideal enter:\n \n>matKrepr(p,'right');\n\nto see matrices representing 1-vectors in a minimal left or right ideal when Q has the signature [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 4867 "matKrepr:=proc() \nlocal mindex,Bsize,dim,ind,pq,pq sig,matdata,i,a1,a2,dimrepr,ans,pqmod8,pqmod4,matdatatable,\n m,f lag_simple,k,L,t,co,x,reprmulm;\nglobal B,matrealL,matcompL,matquatL,m atrealR,matcompR,matquatR:\noptions `Copyright (c) 1995-2009 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: December 20, 2008`;\n################################### ##########\n#Checking argument types\nif not member(nargs,\{0,1,2\}) t hen \n error \"wrong number of arguments: expects 0, 1, or 2 argumen t(s)\" \nend if;\nif member(nargs,\{1,2\}) and not type(args[1],\{list ,clibasmon,climon,clipolynom\}) then\n error \"first argument must b e of type 'list', clibasmon, climon, or clipolynom but received one of type %1\",whattype(args[1]) \nend if;\nif nargs=2 and not member(arg s[2],\{'left','right'\}) then \n error \"second argument, when used, must be 'left' or 'right', but received %1\",args[2] \nend if;\nif n args<>0 then a1:=args[1] end if;\nif nargs=0 or type(a1,\{clibasmon,cl imon,clipolynom\}) then\n if not type(B,matrix) then \n error \+ \"matrix must be assigned to B\"\n elif not type(B,'diagmatrix') th en\n error \"bilinear form B must be diagonal\"\n else \n \+ pq:=Bsignature();\n pqmod8:=(pq[1]-pq[2]) mod 8;\n pqmo d4:=(pq[1]-pq[2]) mod 4;\n flag_simple:=evalb(pqmod4<>1);\n e nd if;\nelif type(a1,list) then pq:=a1:pqmod8:=(pq[1]-pq[2]) mod 8 \ne lse error \"wrong argument(s)\"\nend if;\n############################ ##################\nif type(a1,\{clibasmon,climon,clipolynom\}) then\n mindex:=maxindex(a1):Bsize:=linalg[coldim](B):\n if mindex > Bsiz e then\n error \"input error: maximum index in your input %1 is g reater than the size %2 of the currently defined bilinear form B\",min dex,Bsize \n end if;\nend if;\nif nargs=1 or nargs=0 then a2:='left' else a2:=args[2] end if;\n#read in appropriate data file: \nif member (pqmod8,\{0,1,2\}) then\n if a2='left' then \n #if not as signed(matrealL) then readlib(matrealL) end if;\n matdatatabl e:=matrealL:\n else\n #if not assigned(matrealR) then rea dlib(matrealR) end if;\n matdatatable:=matrealR:\n end i f;\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(matco mpR) then readlib(matcompR) end if;\n matdatatable:=matcompR: \n end if;\nelif member(pqmod8, \{4,5,6\}) then\n if a2='lef t' then\n #if not assigned(matquatL) then readlib(matquatL) e nd if;\n matdatatable:=matquatL:\n else\n #if not assigned(matquatR) then readlib(matquatR) end if;\n matdatat able:=matquatR:\n end if; \n else error \"wrong value of pqmod8: \+ %1\",pqmod8 \nend if;\n#######################################\npqsig: =map(op,[indices(matdatatable)]);\nif not member(pq,pqsig) then\n er ror \"matrices for signature %1 in %2 minimal ideal have not been comp uted yet\",pq,a2 \nend if;\n#######################################\n matdata:=matdatatable[pq]:\nif nargs=0 or type(a1,list) then \n retu rn matdata\nend if;\n#Continue if the first element is a polynomial\nd im:=linalg[coldim](B):dimrepr:=linalg[coldim](rhs(matdata[1]));\nif di m<>nops(matdata) then \n error \"size of B is different from the num ber 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 else return subs(Id=1, reprmulm(args[1..(nargs-2)],rmulm(args[nargs-1],args[nargs],`cmulQ`))) \n end if;\nend proc:\n########################################\nm :=array(1..nops(matdata)):\nfor i from 1 to nops(matdata) do m[i]:=rhs (matdata[i]) end do;\nif type(a1,clibasmon) then\n ind:=Clifford:-ex tract(a1,'integers'): \n if a1='Id' then \n if flag_simple then \n return linalg[diag](1$dimrepr) \n else \n r eturn 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'):\nif flag_simple then \n return subs(Id=1,evalm(eval(subs(K=procname,ans)))) \nend if;\na ns:=eval(subs(K=procname,ans));\nif type(ans,`+`) then ans:=[op(ans)] \+ elif\n type(ans,`*`) then ans:=[ans] else\n error \"unexpected typ e in matKrepr\" \nend if;\nL:=select(type,ans,matrix);\nans:=remove(ty pe,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=remove(type,[op(t)],ma trix));\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(a ns);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 25 "No. 60. Sorting fu nction " }{TEXT 376 7 "bygrade" }{TEXT -1 789 ": it sorts a list of Cl ifford basis monomials, Clifford monomials, or Clifford polynomials. B asis monomials and Clifford monomials are sorted by grade; in case of \+ a tie it sorts by lexicographic order based on the basis monomials. Ho wever, basis monomials are put before Clifford monomials. If any of th e elements is a Clifford polynomial, then ties are resolved by sorting by the weight of each element (defined as the sum of the grades of al l terms) and then by then number of Clifford basis monomials in each e xpression. It returns true or false in each case, and can be used in s orting a list of basis monomials, Clifford monomials, and Clifford pol ynomials 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 1986 "bygrade:=proc(a1::\{clibasmon ,climon,clipolynom\},\n a2::\{clibasmon,climon,clipolynom \}) \nlocal flag1,flag2,flag11,flag22,p1,p2,n1,n2,c1,c2,x,w1,w2;\nopti ons `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008` ;\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 flag 11:=false:\n n1:=Clifford:-extract(p1): \n \+ else p1:=a1;\n flag1:=false:\nend if;\nif type(a2,clibasmon) t hen p2:=a2;\n flag2:=true:\n \+ flag22:=true:\n n2:=Clifford:-ext ract(p2): \n elif type(a2,climon) then p2:=op(cliterms(a2));\n \+ flag2:=true:\n flag22: =false:\n n2:=Clifford:-extract(p2): \n el se p2:=a2;\n flag2:=false:\nend if;\nx:='x':\nif flag1 and flag 2 then\n if nops(n1)nop s(n2) then return false\n else \n if evalb(flag11 and flag22) t hen return lexorder(p1,p2)\n elif evalb(flag11 and not flag22) then return lexorder(p1,p2)\n elif evalb(not flag11 and flag2 2) then return not lexorder(p2,p1);\n else return true\n \+ end if;\n end if; \nelse \n n1:=maxgrade(p1):\n c1:=cliterms(p 1):\n w1:=add(maxgrade(x),x=c1):\n n2:=maxgrade(p2):\n c2:=clite rms(p2):\n w2:=add(maxgrade(x),x=c2):\n if n1=n2 then\n if w1 =w2 then \n if nops(c1)<=nops(c2) then return true else return false end if;\n else if w1 " 0 "" {MPLTEXT 1 0 2122 "commutingelements:=proc(a1::l ist(clibasmon)) \nlocal g,groupgens,L,L2,numfact,f,flag1,flag2,flag3,g en,p,q,i;\nglobal B;\noptions `Copyright (c) 1995-2009 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: December 20, 2008`;\n######################################### ####\nif not type(B,matrix) then \n error \"matrix must be assigned \+ to B\"\nend if;\nif not type(B,'diagmatrix') then \n error \"the bil inear 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=[] t hen 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 th en 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\nfl ag2:=false:L2:=[]:groupgens:=[]:\nfor g in L while 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)=numfact then \n return ( sort(groupgens,bygrade)) end if;\n#Find commuting elements with square 1 mod Id in the specified list of basis monomials\nfor g in L while n ops(groupgens)0)) \n then groupgens:=[op(groupgens) ,g] \n end if;\nend if:\nend do:\nif groupgens=[] then return arg s else return sort(groupgens,bygrade) end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 62. Procedure " }{TEXT 378 16 "factoride mpotent" }{TEXT -1 369 " can factor the given idempotent e into a prod uct 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 with 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\nTypical use: factoridempoten t(f); #here f is expected to be an idempotent\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1737 "factoridempotent:=proc(a1::idempotent) \nlocal T,ee ,i,L,flag,flag1,flag2,b1b2,b1,b2,ans;\nglobal B;\noptions `Copyright ( c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: December 20, 2008`;\n############# ################################\nif a1=Id then return Id end if;\nif \+ not type(B,matrix) then \n error \"matrix must be assigned to B\"\ne nd if;\nif not type(B,'diagmatrix') then \n error \"the bilinear for m B is not diagonal as expected\" \nend if;\nee:=eval(a1):\nL:=sort(re move(member,convert(cliterms(ee),list),[Id]),bygrade):\nif nops(L)=1 t hen \n ans:=(1/2)*(Id+L[1]);\n if displayid(a1-ans)=0 then return \+ ans else return a1 end if;\nend if;\nflag1:=true:\nwhile flag1 do\nfla g2:=true:\nL:=sort(L,bygrade);\nfor b1 in L while flag2 do\nfor b2 in \+ remove(member,L,[b1]) while flag2 do\n b1b2:=cmulQ(b1,b2):\n if \+ member(b1b2,L) then flag2:=false;\n L:=remov e(member,L,[b1b2]) end if;\n if member(-b1b2,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:=commutingelemen ts(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 if;\nend if;\nL:=sort(L,b ygrade);\ni:='i':\nans:='cmulQ'(seq((1/2)*(Id+L[i]),i=1..nops(L)));\ni f eval(ans)-a1=0 then return (ans) end if;\n#try another sign permutat ion\nfor i from 1 to nops(L) do\n L||i:=[L[i],-L[i]]\nend do:\nT:=c ombinat[cartprod]([seq(L||i,i=1..nops(L))]):\nflag:=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\nreturn a1;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 19 "No. 63. Procedure " }{TEXT 379 11 "mak ealiases" }{TEXT -1 996 " allows the user to alias 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 dim ension of the vector space V. A practical limitation on p is of cours e the amount of memory Maple will allocate to store these aliases sinc e every basis monomial, not necessarily written in the standard order, will be aliased. This procedure is intended to be used when p < 5 al though it can be used also when p < 10. Remember that to unalias e12 \+ one needs to either restart Maple or simply assign e12:='e12'.\n\nAs a memory saving feature, option 'ordered' (or \"ordered\") may be enter ed as a second parameter. If the second parameter is used, aliases are created only for monomials with ordered indices, for example, e12 wil l be an alias for e1we2.\n\nThe procedure returns 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 aliased, Clifford multipli cation can be done using these aliases.\n\nTypical use: \n\n>makealias es(3);\n>eval(%);\n" }}{PARA 258 "" 0 "" {TEXT -1 41 "or\n\n>makealias es(3,'ordered');\n>eval(%);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 803 "m akealiases:=proc(a1::posint,a2::\{symbol,string\}) \nlocal L,i,k,l,K,s ;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`,remember;\ndescription `Last revised: De cember 20, 2008`;\n#############################################\nif n ot a1>1 then \n error \"first parameter must be a positive integer l arger than one\" \nend if;\nif nargs=2 and not member(a2,\{'ordered', \"ordered\"\}) then\n error \"second optional parameter, when used, \+ must be 'ordered'\" \nend if;\nk:='k':l:='l':i:='i':\nL:=[seq(op(combi nat[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]))=makecli basmon(K[i]),i=1..nops(K))\nelse\n s:=seq(cat(e,op(L[i]))=makeclibas mon(L[i]),i=1..nops(L))\nend if;\nreturn 'alias'(s)\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 64. Procedure " }{TEXT 380 4 "cinv " }{TEXT -1 1285 " calculates a symbolic inverse of any Clifford polyn omial p in the given Clifford algebra Cl(B) or in its subalgebra. The procedure determines a basis for the smallest subalgebra of Cl(B) in \+ which the inverse might exist. For example, if the polynomial p conta ins only even grades, then the inverse is sought 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\n If the bilinear form B is not assigned then every Clifford polynomial \+ in Cl(B) has a symbolic inverse. If the bilinear form B is assigned th en not every element in Cl(B) has the inverse. For example, nilpotent and non-trivial idempotent elements have no inverses. Elements p suc h that p &c p = a*p for some 'cliscalar' also have no inverses (these elements are called here 'almost idempotent').\n\nThus, if B is assig ned and the inverse does not exist, the procedure tries to identify if p is one of the above types and if so, it returns an appropriate erro r message. Otherwise it returns 'NULL'.\n\nThis procedure can be used with a second optional argument K of type symbol, name, matrix , or a rray. In that case, it computes the inverse in Cl(K). The seconf argum ent 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 4200 "cinv:=proc(a1::\{cliscalar,clibasmon,climon,clipo lynom\}) \nlocal p,pp,pinv,mindex,cinv11,s,aaa,flagB,flagBdiag,S,lname ,flagindexed;\nglobal B,_warnings_flag;\noptions `Copyright (c) 1995-2 009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: December 20, 2008`;\n###################### #######################\nif nargs=1 then\n lname:=`B`;\n flagind exed:=false:\nelif nargs=2 and type(args[2],\{symbol,name,array,matrix ,`&*`(algebraic,name)\}) then\n lname:=args[2];\n flagindexed:=t rue:\nelse error \"only one or two arguments are expected\"\nend if;\n ############################\ncinv11:=proc(a1,lname)\nlocal i,d,dbasis ,N,u,xm,v,uv,vu,vars,sys,L1,v1,nontrivial;\nglobal evenelement;\n no ntrivial:=proc(S::\{set(\{relation,algebraic\}),list(\{relation,algebr aic\})\}) \n local istrivial;\n istrivial: =proc(x) \n if type(x,relation) then evalb(x) else evalb(x=0) end if; \n end proc;\n re move(istrivial,S)\n end proc: \ni:='i':\nd:=maxindex(a1) :\nif type(a1,'evenelement') then dbasis:=cbasis(d,'even')\n \+ else dbasis:=cbasis(d) \nend if:\nN:=nops(dbasis):\nu: =clicollect(reorder(a1)):\nxm:=array(1..N):\nv:=sum(xm[i]*dbasis[i],'i '=1..N);\nuv:=collect(cmul[lname](u,v)-Id,dbasis);\nvu:=collect(cmul[l name](v,u)-Id,dbasis);\nvars:=\{coeffs(v,dbasis)\};\nsys:=\{coeffs(uv, dbasis),coeffs(vu,dbasis)\};\nsys:=nontrivial(sys); #eliminate trivial equations\nL1:=solve(sys,vars);\nif L1=NULL then return (NULL) else \+ \nv1:=subs(L1,v);\nv1:=reorder(v1):\nv1:=clicollect(v1):\nv1:=map(norm al,v1);\nreturn (eval(v1)): \nend if;\nend proc:\n#################### #################\nif type(a1,cliscalar) then\n if a1<>0 then return 1/a1 else error \"0 has no inverse\" end if;\nend if;\nmindex:=maxind ex(a1);\nif mindex=0 then return Id/scalarpart(a1) end if;\np:=simplif y(reorder(a1)):\np:=displayid(p):\npinv:=cinv11(p,lname);\nif evalb(pi nv<>NULL) then return pinv end if; \n################################# ####\nflagB:=type(evalm(lname),matrix):\nif not flagB then return \"un able to find inverse of %1\",a1 end if;\n############################# ########\nif _warnings_flag then\n WARNING(`testing why entered argu ment 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 nilpotent\n################################ #######\nif type([p,lname],nilpotent) 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###Check ing if element a1 is idempotent\n##################################### ##\nif not member(p,\{Id\}) and type([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 current %2 and as such it has no inve rse\",a1,lname\n end if;\nend if;\n################################# ######\n###Checking if a1 is almost idempotent\n###################### ################# \npp:=cmul[lname](p,p):\nif match(pp=aaa*p,cliterms( p),'s') then \n if flagBdiag then \n error \"element 'p'=%1 is alm ost an idempotent since %2 and as such it has no inverse in signature \+ %3\", a1,subs(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 %3\", a1,subs(s,'cmul'('p','p')=aaa*'p') ,lname\n end if;\nend if;\n#######################################\n S:=\{solve(pp-s*p,s)\}:\nif not evalb(S=\{\}) then \n if flagBdiag t hen \n error \"element 'p'=%1 is almost an idempotent since %2 and a s such it has no inverse in signature %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 cu rrent\", 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 "pseudodet" }{TEXT -1 87 " computes p seudodeterminant 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[matrix](2, 2, [Id, e1 + e2, e3, e4we3] ); " }}{PARA 258 "" 0 "" {TEXT -1 37 " pseudo det(M);" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 533 "pseudodet:=proc(a1::\{climatrix,matrix\}) local M,a,b,c,d;\no ptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: December 20, 20 08`;\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]):\nretur n simplify(cmul(a,reversion(d)) - cmul(b,reversion(c)))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 45 "No. 66. Defining quaternionic mutlipl ication " }{TEXT 382 4 "qmul" }{TEXT -1 687 ". Quaternions are define d as the even elements in Cl(3) (or the para-bivectors in Cl(3)). Thus , a quaternion basis is [Id, e3we2,e1we3,e2we1] and it is available as the first component of global variable '_quatbasis' defined at the in itialization time (type _quatbasis or _quatbasis[1] at the Maple promp t to see it). See P. Lounesto, \"Clifford Algebras and Spinors\", pag e 49, for more information on quaternions. Any element that belongs t o this vector space is now of type 'quaternion'. The infix form of thi s multiplication is `&q`. Via the procedure 'rmulm', the quaternioni c multiplication may also be applied to matrices with quaternionic ent ries and is then denoted by `&qm`." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 121 "NOTE: in order to see answers displa yed in terms of the basis \{Id, qi, qj, qk\}, apply 'qdisplay' to the \+ result of 'qmul'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 105 "Typical use: qmul(Id + e1we2, e1we3); or (Id + 2*e1w e2) &q (e2we3 + e1we2); or (Id + qi) &q (qj + qk); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1299 "qmul:=proc() local q1,q2,q3,step1,repqmul; \n \+ global B,qi,qj,qk,_default_Clifford_product;\nopti ons `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008` ;\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 na rgs=2 then return 'qmul'(args) else\n return repqmul(args[1..(n args-2)],'qmul'(args[nargs-1],args[nargs])) \n end if;\n end pro c:\nif nargs>2 then \n q3:=eval(repqmul(args)):\n return qdisplay( map(combine,q3,trig)) \nend if;\n_default_Clifford_product:='cmulNUM': \nq1:=eval(args[1]):q2:=eval(args[2]):\nif type(q1,`^`) or type(q2,`^` ) then \n error \"illegal expression found: use 'qinv' for the quate rnionic inverse\" \nend if;\nif type(q1,cliscalar) or type(q2,cliscala r) then \n return qdisplay(q1*q2) \nend if;\nif q1=Id then return qd isplay(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(q1,q2));\nreturn qdisplay(map(combine,clicoll ect(step1),trig))\nend proc:\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 conjugati on " }{TEXT 387 8 "q_conjug" }{TEXT -1 112 ". Recall that complex con jugation was named 'c_conjug' while the Clifford conjugation was just \+ 'conjugation'. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 " " {TEXT -1 68 "Typical use: q_conjug(Id + 2*e1we2); or q_conjug(Id + 2 *qi + qk); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 558 "q_conjug:=proc(q ::algebraic) local q1; global qi,qj,qk;\noptions `Copyright (c) 1995-2 009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: December 20, 2008`;\n###################### #######################\nif type(q,matrix) then return map(procname,q) elif\n type(q,\{cliscalar,quaternion\}) then\nq1:=eval(q):\nif type (q1,cliscalar) then return q1 \nelse\n return qdisplay(2*scalarpart (q1)-q1)\nend if;\nelse\n error \"wrong input types: input must be o f 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 us e: qnorm(Id + 2*e1we2); or qnorm(Id + qi + qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 447 "qnorm:=proc(q ::\{cliscalar,quaternion\}) local q1,n,co; global qi,qj,qk;\noptions ` Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n## ###########################################\nq1:=expand(eval(q));\nif \+ type(q1,cliscalar) then return abs(q1) \nelse\n n:=0:for co in [coef fs(q1,cliterms(q1))] do n:=n+co^2 end do;\n return combine(sqrt(n),t rig) \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 inverse of a Clifford polynomial can be calculated wit h 'cinv' and that quaternions form a noncommutative division ring. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 66 "Typ ical 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 457 "qi nv:=proc(q::\{cliscalar,quaternion\}) local q1,q2; \noptions `Copyrigh t (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: December 20, 2008`;\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\nelse q2:=q_conjug(q1)/(qnorm(q1))^2:\n return qd isplay(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 quaternions or matrices with quaternionic entries in te rms of the basis \{Id, qi, qj, qk\}. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 360 93 "Typical use: qdisplay(e1we2 + 2*I d); map(qdisplay, matrix(2, 2, [Id, e1we2, e2we3, e1we3])); " }{TEXT -1 2 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 723 "qdisplay:=proc(a1::\{ algebraic,array\}) local q; global qi,qj,qk;\noptions `Copyright (c) 1 995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: December 20, 2008`;\n################# ############################\nif type(a1,matrix) then\n if not type( a1,climatrix) then \n return evalm(a1) else \n return map(qd isplay,a1) \n end if;\nend if;\nq:=eval(simplify(a1)):\nif type(q,cl iscalar) then return q end if;\nif type(q,quaternion) then\nq:=map(com bine,clicollect(reorder(q)),trig);\nreturn coeff(q,Id)-coeff(q,e1we2)* 'qk'+coeff(q,e1we3)*'qj'-coeff(q,e2we3)*'qi'\nelse \nerror \"wrong inp ut type: input must be of type 'cliscalar', 'quaternion', or 'matrix' \+ \" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 72. Pr ocedure " }{TEXT 391 5 "rot3d" }{TEXT -1 161 " rotates a vector in 3-d imensional Euclidean space V using the quaternion multiplication. Na mely, any vector v is transformed 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 "where q is a quaternion given in the basis [Id, e1we2, e 1we3, e2we3]. The first entry should be a vector (or any element of th e Clifford algebra) while the second element is a quaternion. Type '_ quatbasis' to see how quaternions are defined here. Elements 'qi', 'q j', 'qk' are defined at the time of initialization and denote the pure -quaternion basis elements. It is assumed that the user has defined a bilinear form B as 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 "before using 'rot3d'. Of course, 'rot3d' will also wo rk if the first argument were any element in Cl(3). \n" }}{PARA 258 " " 0 "" {TEXT -1 296 "NOTE: traditionally one uses \{1, i, j, k\} to de note a quaternion basis. Here, we are using symbol 'qi' for 'i', 'qj' for 'j', and 'qk' for 'k'. Symbol 'Id' denotes, as usual, the unit e lement in all Clifford algebras as well as the unit element in reals, \+ complexes, quaternions, 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 857 "rot3d:=proc(a1::\{cliscalar,clibasmon,climon, clipolynom\},\n a2::quaternion) \nlocal q2,q2inv; global B, qi,qj,qk; \noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: De cember 20, 2008`;\n#############################################\nif n ot assigned(B) or not type(B,matrix) then \n error \"bilinear form B has not been assigned yet. It must be defined as the identity 3 x 3 m atrix.\"\nend if:\nif not linalg[equal](B,linalg[diag](1$3)) then \n \+ error \"the identity 3 x 3 matrix must be assigned to B\" \nend if;\n if 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 cl icollect(clisort(map(combine,cmulQ(q2,a1,q2inv),trig))) \nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 73. Procedure " }{TEXT 392 9 "i sproduct" }{TEXT -1 238 " can determine whether the given Clifford pol ynomial, e.g. p := Id + 4*e1we2 + e3we4, is a product of 1-vectors in the given Clifford 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 "ispro duct(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 Clifford product v1 &c v2 &c ... &c vn = p;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 161 "isproduct( p, 'all'); answers true or false, and gives a list of general vecto rs [v1, v2, ..., vn] such that the Clifford product v1 &c v2 &c ... &c vn = p;\n\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4895 "isproduct:=proc( p::\{cliscalar,clibasmon,climon,clipolynom\},\n s::\{st ring,symbol\}) \nlocal M,maxg,T,co,vv,x,cf,pnew,p1,L,v,j,S,S2,i,v1v2,e xpr,t,sys,\nvars,sol,ventries,flag,flagB,flagtB,param,flagsol,eq,P1,P2 ,die,parvalues;\nglobal _MaxSols,B;\noptions `Copyright (c) 1995-2009 \+ by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndesc ription `Last revised: December 20, 2008`;\n########################## ###################\nif not member(nargs,\{1,2\}) then\n error \"one o r two arguments needed of type 'cliscalar', 'clibasmon', 'climon', 'cl ipolynom', and 'symbol'\"\nend if;\nif nargs=2 and not member(s,\{'all ','any'\}) then\n error \"second (optional) argument must be 'all' o r 'any'\"\nend if;\nif not type(B,diagmatrix) then \n error \"diagon al matrix must be assigned to B\" end if;\nmaxg:=maxgrade(p);\n####### ##############################################\n#An element of grade 0 is always factorable in Cl(B):\n##################################### ################\nif maxg=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 f lag 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 i f;\n#####################################################\n#Any 1-vect or is already factored:\n############################################# ########\nif vectorpart(p,1)-p=0 then \n if nargs=1 then return true \n else return [true,[p]] \n end if;\nend if;\n######## #############################################\n#Any basis monomial is \+ already factored:\n################################################### ##\nflagB:=type(B,diagmatrix):\np1:=factor(reorder(displayid(p))):\nfl agtB:=evalb(type(p1,\{clibasmon,climon\}) and flagB):\nif flagtB then \+ \n S:=op(Clifford:-extract(p1,'integers'));\n if nargs=1 the n 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 the special cases above,\n#find common indices to all monomial terms in p, if any,\n#and then simplify p by factoring o ut the common factors:\n############################################## ###########\nT:=cliterms(p):\nco:=`intersect`(op(map(convert,map(Cliff ord:-extract,T,'integers'),set)));\nx:='x':\nif nops(co)<>0 then\n c o:=sort(convert(co,list));\n vv:=[seq(cat(e,x),x=co)];\n cf:=cmul( op(vv));\n pnew:=cmul(p,cf,cf,cf);\n if nargs=1 then M:=procname(p new) \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 i f; \n#####################################################\n#This is \+ the most general case when no common indices\n#in monomial terms are f ound:\n#####################################################\nS2:=map( Clifford:-extract,cliterms(p),'integers');\nS:=\{op(map(op,S2))\}; \nv :=table([]):\nfor j from 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..m axg));\nexpr:=clicollect(simplify(reorder(p-v1v2))):\nt:=cliterms(expr );sys:=\{\}:\nfor i from 1 to nops(t) do sys:=\{op(sys),coeff(expr,op( i,t))=0\} end do:\nvars:=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 i f;\nventries:=[seq(v[j],j=1..maxg)];\n################################ #######################\n#Finally, we need to return result in appropr iate form.\n#By now, if p were not factorable, 'false' should have\n#b een returned:\n####################################################### \nif nargs=1 then return true end if; \nif nargs=2 and s='all' then re turn [true,subs(sol[1],ventries)] end if; \n########################## ###############################\n#If the second parameter is 'any', as sign random values\n#to 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])\};\nparvalues:=[1,-1,1/2,-1/2,1/3,-1/3];\ndie := rand(1..6) :\nfor eq in select(param,S2) do \n if rhs(eq)=0 then P1:=P1 union \{ eq\}\n else 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,subs(P1,map(denom,L))) then flagsol:=true end if; \nend do:\nif flagsol then return [true,subs(P1,subs(P2,ventries))]\n \+ else return [true,subs(sol[1],ventries)]\nend if;\nend if;\n end proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 74. Procedure " }{TEXT 393 14 "isVahlenmatrix" }{TEXT -1 258 " determines if the given 2 x 2 matrix is Vahlen matrix as defined in P. Lounesto, \"Clical and counter-examples\", in eds. R. Ablamowi cz, P. Lounesto, and J. Parra, `Clifford algebras with symbolic and nu meric computations`, Birkhauser, Boston, 1996, page 19." }}{PARA 258 " " 0 "" {TEXT -1 349 "\nVahlen 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. th e 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), reversion(b) &c d, d &c reversion(c), and reversi on(c) &c a are all vectors." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 31 "Typical use: isVahlenmatrix(V);" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 120 "V := matrix(2, 2, [Id - e1we4, -e1 + e4, e1 + e4, Id + e1we4]) (this exam ple of Vahlen matrix is due to Johannes Maks)." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1213 "isVahlenmatrix:=p roc(cm::\{matrix,climatrix\}) \nlocal expr1,expr2,a,b,c,d,m; global B; \noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\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) then return false fi end if;\nif b<>0 th en if not isproduct(b) then return false fi end if;\nif c<>0 then if n ot isproduct(c) then return false fi end if;\nif d<>0 then if not ispr oduct(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(vecto rpart(expr1,1));\nif not evalb(simplify(expr1-expr2)=0) then return fa lse end if;\nexpr1:=simplify(cmul(reversion(b),d));\nexpr2:=simplify(v ectorpart(expr1,1));\nif not evalb(simplify(expr1-expr2)=0) then retur n false end if;\nexpr1:=simplify(cmul(d,reversion(c)));\nexpr2:=simpli fy(vectorpart(expr1,1));\nif not evalb(simplify(expr1-expr2)=0) then r eturn false end if;\nexpr1:=simplify(cmul(reversion(c),a));\nexpr2:=si mplify(vectorpart(expr1,1));\nif not evalb(simplify(expr1-expr2)=0) th en 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 "climinpoly" }{TEXT -1 407 " finds the m inimal polynomial of any Clifford polynomial 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 are linearly independent, k=1..(n-1) where n = degree of the minimal polynomial of p. If the second option al argument is 'horner' then polynomial is returned in 'horner' form. \+ This procedure can accept now optional 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 1407 "c liminpoly:=proc(p::\{cliscalar,clibasmon,climon,clipolynom\})\nlocal d p,L,flag,pp,expr,a,k,eq,sys,vars,sol,poly,lname;\noptions `Copyright ( c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: December 20, 2008`;\n############# ################################\nif type(op(procname),procedure) then \n lname:=`B`;\n else\n lname:=op(procname);\nend if;\ndp:=disp layid(p):\nif maxgrade(dp)=0 then L:=[Id] else L:=[Id,dp] end if;\nfla g:=false:k:='k':a:='a':\nwhile not flag do\npp:=cmul[lname](L[nops(L)] ,dp):\nexpr:=expand(add(a[k]*L[k],k=1..nops(L)));\neq:=clicollect(pp-e xpr);\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'^nops(L)-add(a[k]*'x'^(k-1),k=1..no ps(L));\npoly:=sort(subs(sol,poly)); \nif nargs=1 then return poly\nel if nargs=2 then\n if args[2]='powers' then return [poly,L]\n \+ elif args[2]='horner' then return convert(poly,horner)\n else e rror \"second (optional) argument must be 'powers' or 'horner' \"\n \+ end if;\nelif nargs=3 then\n if member(args[2],\{'powers','horne r'\}) and\n member(args[3],\{'powers','horner'\}) then\n \+ return ([convert(poly,horner),L])\n else error \"wrong argu ments\"\n end if;\nelse error \"wrong number of arguments: one, tw o, or three arguments are needed only\"\nend if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 76. Procedure " }{TEXT 395 15 "subs _climinpoly" }{TEXT -1 283 " substitutes any Clifford polynomial p int o any polynomial pol in one variable. It may be used with an optional \+ third argument in which case it returns unevaluated polynomial pol in \+ 'horner' form. For example, one can use this procedure to verify that \+ the given Clifford polynomial p" }{TEXT 356 1 " " }{TEXT -1 37 "satisf ies its own minimal polynomial." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 197 "Typical use: subs_climinpoly(p,pol);\n subs_climinpoly(p,pol, 'horner');\n \+ subs_climinpoly(p,pol, \"horner\");\n subs_cli minpoly(p,pol, horner);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1333 "subs _clipolynom:=proc(clinumber::\{symbol,cliscalar,clibasmon,climon,clipo lynom\},\n minpoly::polynom,o::\{symbol,string \}) \nlocal ph,d,k,r,q,h,expr,s,var,varx,dclinumber;\noptions `Copyrig ht (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: December 20, 2008`;\n######### ####################################\nph:=convert(minpoly,horner);\nva r:=op(remove(type,indets(ph),indexed));\nif not type(eval(clinumber), \{clibasmon,climon,clipolynom\}) \n then return subs(var=clinumber,p h) \nend if;\nif nops(\{var\})<>1 then varx:=op(select((member,\{var\} ,\{x,y,z\}))) else varx:=var end if;\nif nops(\{varx\})<>1 then \n e rror \"expecting only one of x, y, or z as a variable in %1 but found \+ %2\",minpoly,varx \nend if:\nd:=degree(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:=displayid(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 ex pr \n else \n error \"third (optional) argument, when used, \+ must be 'horner', but received %1 instead\",args[3]\n end if;\nelse \+ error \"wrong number of arguments\"\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 77. Procedure " }{TEXT 396 4 "sexp" } {TEXT -1 427 " finds a power series expansion of a Clifford polynomial p up to and including order n modulo the minimal polynomial of p. It \+ is recommended that this procedure be used when n > d, where d is the \+ degree of the minimal polynomial of p. Otherwise, use 'cexp' or 'cexpQ ' instead. The reason is that 'sexp' is faster than 'cexp' when n > d, but is is slower when n <= d. This procedure can use an optional argu ment 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 1526 "sexp:=proc(p::\{numeric,cliscalar,clibasmon,climon,clipolynom\}, n::nonnegint) \nlocal k,pp,pol,powrs,co,te,nte,lname,coB,nameB;\noptio ns `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: December 20, 2008`; \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(select(ty pe,\{op(args[3])\},numeric));\n nameB:=op(remove(type,\{op(args[ 3])\},numeric));\n lname:=args[3]:\n else \n error \"wr ong type of third argument in sexp. See ?sexp for more help.\" \n en d if;\nelse\n error \"two or three arguments expected in sexp. See ? sexp for more help.\"\nend if;\n##################################### \nif n=0 then \n if type(p,\{numeric,'cliscalar'\}) then return 1 el se return Id fi\nend if;\nk:='k':\nif type(p,\{numeric,cliscalar\}) th en return add(p^k/k!,k=0..n) end if;\nif evalb(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:=pol[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[degree(te[k],'x')+1] \nend do;\n return 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-s imple, complex, quaternionic, quaternionic simple, and quaternionic se mi_simple Clifford algebras up to and including the dimension specifie d as the first parameter. Second parameter, when used, must be 'real', 'complex', or 'quat', while the third parameter must be 'simple' or ' semisimple'.\n\nUse: all_sigs(9,'real','simple');\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2807 "all_sigs:=proc(r) \nlocal s1,s2,mi,ma,P,Q,p,q,pq ,r_pq,c_pq,q_pq,x,\nsimple_r_pq,simple_q_pq,semisimple_r_pq,semisimple _q_pq;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Decemb er 20, 2008`;\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,\{string,symbol\})\nthen\nWAR NING(`try first argument as range, e.g., 1..9, second argument as 'rea l', 'complex', or 'quat', and third arguments as 'simple' or 'semisimp le' instead of:`);\nreturn 'procname(args)'\nend 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 return r_pq elif\n s1='c omplex' then return c_pq elif\n s1='quat' then return q_pq else\n error \"second input string must be 'real', 'complex' or 'quat' \+ but received %1\",args[2] \n end if:\nend if: \n################### ###############\nif s1='real' then\n simple_r_pq:=[]:semisimple_r _pq:=[]:\n for x in r_pq do \n if member(x[1]-x[2] mod 8 ,\{1\}) then \n semisimple_r_pq:=[op(semisimple_r_pq),x] \+ \n else \n simple_r_pq:=[op(simple_r_pq),x]\n \+ end if;\n end do:\n if s2='simple' 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 r eceived %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 if:\nend if;\n########## ########################\nif s1='quat' then\n simple_q_pq:=[]:sem isimple_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' then return semisimple_q_p q else\n error \"third argument must be 'simple' or 'semisimpl e' but received %1 instead\",args[3]\n end if:\nend if;\nerror \" wrong number of arguments. See ?all_sigs for more help.\"\nend proc:\n " }}{PARA 0 "" 0 "" {TEXT 357 18 "No. 79. Procedure " }{TEXT 399 9 "ad fmatrix" }{TEXT 400 116 " accomplishes addition of two matrices of typ e 'dfmatrix', that is, matrices whose entries belong to a double field \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 370 "adfmatrix:=proc(M1::dfmatrix , M2::dfmatrix) local L1, L2;\noptions `Copyright (c) 1995-2009 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: December 20, 2008`;\n################################ #############\n L1:=ddfmatrix(M1);\n L2:=ddfmatrix(M2);\n ret urn 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 " and " }{TEXT 401 10 "beta_m inus" }{TEXT 402 374 " [originally procedure 'beta' from the package ' double'] are now part of \"CLIFFORD\". They give two scalar bilinear f orms in the spinor ideal S of Cl(Q).\n\nUsage: beta_plus(psi,phi,f); b eta_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 a n optional argument that will store 'purescalar'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2005 "beta_plus:= proc(psi,phi,f) \nlocal locf,locdata ,y,m,flag,mons,uu,eq,lambda,sys,sol,Kbas,v,i,vars,flagf;\nglobal B,_pr olevel;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bert fried Fauser. All rights reserved.`;\ndescription `Last revised: Decem ber 20, 2008`;\n#############################################\nif not \+ _prolevel then\n if not type(psi,\{cliscalar,clibasmon,climon,clipolyn om\}) then \n error \"first argument must be of type 'cliscalar', 'cl ibasmon', 'climon', or 'clipolynom'\" \n end if;\n if not type(phi,\{c liscalar,clibasmon,climon,clipolynom\}) then \n error \"second argume nt must be of type 'cliscalar', 'clibasmon', 'climon', or 'clipolynom' \" \n end if;\nend if;\n###Load in pre-computed data and check if idem potents are the same\nlocdata:=clidata(B):\nlocf:=eval(locdata[4]);\nK bas:=locdata[6];\nif nops(Kbas)>1 then\n flagf:=evalb(f=eval(locf) o r f=gradeinv(locf) or \n f=-gradeinv(locf) or f=-eval(l ocf));\n if not flagf then\nerror \"when K = C or K = H, primitive i dempotent f = plus/minus clidata(B)[4] or its grade involution\"\n e nd 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 := clic ollect(cmul(m,y) - expand(cmul(lambda,f)));\n sys := \{coeffs(e q, 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 opti onal argument, when used, must be of type unprotected name\"\n e lse assign(args[4],uu) \n end if;\n end if;\n lambda:=subs (sol,lambda):\n if vectorpart(lambda,0)=lambda then return (scalarp art(lambda)) \n else return lambda\n end if;\nend proc:\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 2037 "beta_minus:= proc(psi,phi,f) \nlo cal locf,locdata,y,m,flag,mons,uu,eq,lambda,sys,sol,Kbas,v,i,vars,flag f;\nglobal B,_prolevel;\noptions `Copyright (c) 1995-2009 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: December 20, 2008`;\n###################################### #######\nif not _prolevel then\n if not type(psi,\{cliscalar,clibasmon ,climon,clipolynom\}) then \n error \"first argument must be 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-computed data an d check if idempotents are the same\nlocdata := clidata(B):\nlocf := e val(locdata[4]);\nKbas := locdata[6];\nif nops(Kbas)>1 then\n flagf: =evalb(f=eval(locf) or f=gradeinv(locf) or \n f=-gradei nv(locf) or f=-eval(locf));\n if not flagf then\n error \"when \+ K = C or K = H, primitive idempotent f = plus/minus clidata(B)[4] or i ts grade involution\"\n end if;\nend if;\n###\n y := cmul(conjuga tion(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[col dim](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 th en\n if not type(args[4],name) or type(args[4],protected) then \+ \n error \"fourth optional argument, when used, must be of ty pe unprotected name\"\n else assign(args[4],uu) \n en d if;\n end if;\n lambda:=subs(sol,lambda):\n if vectorpart(l ambda,0)=lambda then \n return scalarpart(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 o r from a serquence of to matrices.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 922 "cdfmatrix:=proc() local l1,l2,L,i,j,m,n,m1,m2,MN;\noptions `Cop yright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: December 20, 2008`;\n##### ########################################\nif nargs=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 number or types of argume nts. See ?cdfmatrix for help.\" \nend if;\n l1:=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 en d do:\n end do:\n return evalm(MN)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 363 18 "No. 83. Procedure " }{TEXT 407 9 "ddfmatrix" }{TEXT 408 64 " decomposes a matrix over double field into a pair of matrices .\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 461 "ddfmatrix:=proc(M::dfmatrix ) local m,n,i,L1,L2,L;\noptions `Copyright (c) 1995-2009 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n####################################### ######\n m:=linalg[rowdim](M);\n n:=linalg[coldim](M);\n L:=c onvert(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[matrix](m,n,L1),linalg[matr ix](m,n,L2)]\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 364 18 "No. 84. Procedure " }{TEXT 409 11 "diagonalize" }{TEXT 410 42 " tr ies to diagonalize a symmetric matrix.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 785 "diagonalize:=proc(m::symmatrix) local locB,flag,i,j, L,v,S,Bdiag;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: \+ December 20, 2008`;\n#############################################\nif linalg[coldim](m)<>linalg[rowdim](m) then\n error \"expected a squa re matrix as input\" \nend if;\nif type(m,diagmatrix) then \n return evalm(m) \nend if; \nL:=[linalg[eigenvects](m)];\nflag:=true:\nfor i \+ from 1 to nops(L) while flag=true do\n if L[i][2]>nops(L[i][3]) the n flag:=false end if: \nend do: \nif not flag then \n error \"since \+ matrix entered does not have a complete set of linearly independent ei genvectors, it is not diagonalizable\" \nend if;\nreturn linalg[diag]( seq(seq(L[i][1],j=1..L[i][2]),i=1..nops(L)))\nend proc:\n" }}{PARA 0 " " 0 "" {TEXT 365 6 "No. 85" }{TEXT -1 1 "." }{TEXT 366 11 " Procedure \+ " }{TEXT 411 9 "mdfmatrix" }{TEXT 412 46 " multiplies two matrices ove r a double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 366 "mdfmatrix:= proc(M1::dfmatrix,M2::dfmatrix) local L1, L2;\noptions `Copyright (c) \+ 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: December 20, 2008`;\n################ #############################\n L1:=ddfmatrix(M1);\n L2:=ddfmatr ix(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 element x in the given Clifford algebra such that cmul(x,a1) = cmul(a2,x) where a1 and a2 ar e the first two arguments of type 'clibasmon', 'climon', or 'clipolyno m'. \n\nIf only two arguments are passed to the procedure, element x b elongs to the Clifford algebra over the lowest dimension dim = max(max index(a1),maxindex(a2)). \n\nIf three arguments are used with the thi rd argument being a list of elements of type 'clibasmon', '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 argument a4 is used, \+ then the third argument is expected to be a list of elements of type ' clibasmon', in which case the procedure searches for 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 1472 "cocycle:=proc(a1::\{clibasmon,climon,clipolynom\}, \n a2::\{clibasmon,climon,clipolynom\},\n a3 ::list(\{clibasmon,climon,clipolynom\}),\n a4::symbol) \n local g,v,n,llist,i,d,S,x,y,xy,sys,vars,sol,llist1,llist2,llist3;\nopt ions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser . All rights reserved.`;\ndescription `Last revised: December 20, 2008 `;\n#############################################\n#if a1=a2 then retu rn [Id] end if;\nif nargs=4 and member(args[4],\{clibasmon,clibasmon\} ) then\n llist:=a3:\n S:=[]:\n for i from 1 to nops(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 th en\n S:=[op(S),llist[i] ]:\n end if: \n end if: \+ \n end if:\n end do:\nreturn S\nend if;\nif nargs=3 then\n llist1 :=`union`(op(map(cliterms,remove(member,\{seq(op(\{cmul(a1,g),cmul(g,a 1)\}),g=a3)\},\{0\})))):\n llist2:=`union`(op(map(cliterms,remove(mem ber,\{seq(op(\{cmul(a2,g),cmul(g,a2)\}),g=a3)\},\{0\})))):\n llist3:= map(op@cliterms,convert(a3,set)); \n llist:=convert(`union`(llist1,l list2,llist3),list):\n llist:=sort([op(llist),op(cliterms(op(a3)))],b ygrade):\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);\nsol:=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\nTypical use:\n\nclisolve(eq,pp);\nclisolv e(eq,set);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 593 "clisolve:=proc(eq: :\{clibasmon,climon,clipolynom\},indet::\{list,algebraic\}) \nlocal i, T,vars,sol,sys;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: December 20, 2008`;\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 typ e(indet,list) then\n return sol\nelse\n return [seq(subs(sol[i],inde t),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, Clip lus, GTP, Octonion, and Bigebra packages, when these packages are load ed.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6579 "CLIFFORD_ENV:=proc() glo bal _warnings_flag:\noptions `Copyright (c) 1995-2009 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: December 20, 2008`;\n########################################## ###\nif not assigned(Clifford) then \n lprint(`>>> Package Clifford \+ has not been loaded yet. Type 'with(Clifford)' at the Maple prompt to \+ load it first. <<<`)\nelse\n print('``');###Print blank line\n lprint( `>>> Global variables defined in Clifford:-setup are now available and have these values: <<<`);\nlprint(`************* Start *************` ); \n########################\nlprint('dim_V'=dim_V);\n #(dimensio n of the carrier space for Cl(V,B))\nif not member(dim_V,\{1,2,3,4,5,6 ,7,8,9\}) and _warnings_flag then\n lprint(`Warning, value of dim_V \+ is expected to be a positive integer between 1 and 9, inclusive.`);\n \+ print('``');###Print blank line\nend if;\n########################\n lprint('_default_Clifford_product'=_default_Clifford_product);\n \+ #(controls whether cmulRS or cmulNUM is used in Clifford product 'cmul ')\n#lprint(`Possible values are: 'cmulRS','cmulNUM','cmulgen','cmul_u ser_defined'.`);\nif not member(_default_Clifford_product,\{'cmulRS',' cmulNUM','cmulgen','cmul_user_defined'\}) \n and _warnings_flag then \n lprint(`****** SERIOUS WARNING ******`); \n lprint(`>>> Value o f _default_Clifford_product was expected to be 'cmulRS', 'cmulNUM', 'c mulgen', or 'cmul_user_defined'. <<<`);\n lprint(`****************** ***********`);\nend if;\n########################\nlprint('_prolevel'= _prolevel);\n #(controls whether or not parsing is done)\nif not \+ member(_prolevel,\{true,false\}) and _warnings_flag then\n lprint(`W arning, value of _prolevel is expected to be true or false.`);\n pri nt('``');###Print blank line\nend if;\n########################\nlprin t('_shortcut_in_minimalideal'=_shortcut_in_minimalideal);\n #(con trols flow in procedure 'minimalideal')\nif not member(_shortcut_in_mi nimalideal,\{true,false\}) and _warnings_flag then\n lprint(`Warning , value of _shortcut_in_minimalideal is expected to be true or false.` );\n print('``');###Print blank line\nend if;\n##################### ###\nlprint('_shortcut_in_Kfield'=_shortcut_in_Kfield);\n #(contr ols flow in procedure 'Kfield')\nif not member(_shortcut_in_Kfield,\{t rue,false\}) and _warnings_flag then\n lprint(`Warning, value of _sh ortcut_in_Kfield is expected to be true or false.`);\n print('``');# ##Print blank line\nend if;\n########################\nlprint('_shortc ut_in_spinorKbasis'=_shortcut_in_spinorKbasis);\n #(controls flow in procedure 'spinorKbasis')\nif not member(_shortcut_in_spinorKbasis ,\{true,false\}) and _warnings_flag then\n lprint(`Warning, value of _shortcut_in_spinorKbasis is expected to be true or false.`);\n pri nt('``');###Print blank line\nend if;\n########################\nlprin t('_shortcut_in_spinorKrepr'=_shortcut_in_spinorKrepr);\n #(contr ols flow in procedure 'spinorKrepr')\nif not member(_shortcut_in_spino rKrepr,\{true,false\}) and _warnings_flag then\n lprint(`Warning, va lue of _shortcut_in_spinorKrepr is expected to be true or false.`);\n \+ print('``');###Print blank line\nend if;\n########################\n lprint('_warnings_flag'=_warnings_flag);\n #(controls whether som e procedures, e.g., 'wedge', give warnings)\nif not member(_warnings_f lag,\{true,false\}) then\n lprint(`Warning, value of _warnings_flag \+ is expected to be true or false.`);\n print('``');###Print blank lin e\nend if;\n########################\nlprint('_scalartypes'=_scalartyp es);\n #(defines types considered to be 'scalars' by 'clibilinear ' and 'clilinear')\n########################\nlprint('_quatbasis'=_qua tbasis);\n #(defines default quaternionic basis')\nlprint(`****** ******* End *************`);\nprint('``');###Print blank line \nend if ;\n########################\nif assigned(Cliplus) then\n print('``');# ##Print blank line\n lprint(`>>> Global variables defined in Cliplus:- setup are now available and 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' is 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 'c lirev')\n lprint('macro(LC=LCbig)');\n #('LC' is now extended by \+ 'LCbig')\n lprint('macro(RC=RCbig)');\n #('RC' is now extended by 'RCbig')\n if _warnings_flag then \n lprint(`Warning, new definit ions for type/climon and type/clipolynom now include &C`);\n end if;\n lprint(`************* End *************`);\n print('``');###Print bla nk line \nend if;\n\n################################################# ###\n### Executable Bigebra file for Maple 6 is Bigebra6\n############ ########################################\nif assigned(Bigebra6) then\n print('``');###Print blank line\n lprint(`>>> Global variables define d in Bigebra:-init are now available and have these values: <<<`);\n \+ lprint(`************* Start *************`);\n lprint('_CLIENV[_SILENT ]'=_CLIENV[_SILENT]); #controls messaging upon starting 'Bigebra'\n l print('_CLIENV[_QDEF_PREFACTOR]'=_CLIENV[_QDEF_PREFACTOR]); #prefacto r in 'switch'\n lprint(`************* End *************`);\n print('`` ');###Print blank line\nend if;\n##################################### #####\nif assigned(GTP) then\n print('``');###Print blank line\n lprin t(`************* Start *************`);\n lprint(`>>> There are no new global variables or macros in GTP yet. <<<`);\n lprint(`************* End *************`);\n print('``');###Print blank line \nend if;\n### #######################################\nif assigned(Octonion) then\n \+ print('``');###Print blank line\n lprint(`>>> Global variables defined in Octonion:-setup are now available and have these values: <<<`);\n print('``');###Print blank line\n lprint(`************* Start ******* ******`); \n lprint('_octbasis'=_octbasis); #standard octoni on basis as Maple global variable\n lprint('_pureoctbasis'=_pureoctbas is); #pure octonion basis as Maple global variable\n lprint('_default _Fano_triples'=_default_Fano_triples); #default list of Fano triples\n lprint('_default_squares'=_default_squares); #default squares of e1,e 2,e3,e4,e5,e6,e7\n lprint('_default_Clifford_product'=_default_Cliffor d_product); #selects cmulNUM 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 "makec libasmon" }{TEXT 419 402 " that takes a list and makes Grassmann basis monomials. It is expected, that the list contains positive integers b etween 1 and 9 inclusive, or symbolic indices consisting of one-charac ter strings. If the list is empty, then Id is returned. If any two ele ments in the list are peated, then 0 is returned. This procedure has a remember table.\n\nTypical use: makeclibasmon([]); makeclibasmon([1,7 ,i,j,3]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 474 "makeclibasmon:=proc (x::list) \nlocal result,N,i;\noptions `Copyright (c) 1995-2009 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`,remember;\nd escription `Last revised: December 20, 2008`;\n####################### ######################\n N:=nops(x);\n if N = 0 then return Id end i f;\n if N > nops(convert(x,set)) then return 0 end if;\n result:=c at(e,x[1]);\n for i from 2 to N do\n result:=cat(result,cat(we ,x[i]));\n end do:\nreturn result\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 90. Procedure " }{TEXT 474 12 "rd_clibasmon" }{TEXT -1 405 " generates a random Grassmann basis monomial. It can be used w ithout any arguments in which case default values are used internally, or with 1 or 2 arguments as follows:\n\nNT1 = maximum allowed index v alue (default 9)\nNT2 = maximum allowed grade (default 4)\n\nrd_clibas mon(); then NT1 = 9, NT2 = 4 \nrd_clibasmon(a1); the n NT1 = a1, NT2 = 4\nrd_clibasmon(a1,a2); then NT1 = a1, NT2 = a2\n \n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1404 "rd_clibasmon:=proc() local ind,NT1,NT2,nt1d,nt2d,L;\noptions `Copyright (c) 1995-2009 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: December 20, 2008`;\n#################################### #########\n### NT1 = maximum 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(ar gs[1]<=9 and args[1]>= 0) then\n error \"argument must be non neg ative integer between 0 and 9 giving the maximum monomial index\"\n \+ end if;\n NT1,NT2:=args[1],rand(0..args[1])():\n L:=[[]]: \n eli f 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 argument must be non ne gative integer between 0 and 9 giving maximum monomial index. Second a rgument must be non negative integer between 0 and first argument givi ng maximum possible grade. Other arguments, if present, are ignored.\" \n end if;\n NT1,NT2:=args[1],min(args[1],args[2]):\n L:=[]:\n \+ end if:\n##############\nL:=[op(L),op(combinat[choose](NT1,NT2))];\n ind:=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 m onomial. It can be used without any arguments in which case default va lues are used internally, or with 1, 2, or 3 arguments as follows:\n\n NT1 = maximum allowed index value (default 9)\nNT2 = maximum allowed g rade (default 4)\nNT3 = maximum absolute value of coefficients allowed (default 12)\n\nrd_climon(); then NT1 = 9, NT2 = 4, N T3 = 12 \nrd_climon(a1); then NT1 = a1, NT2 = 4, NT3 = 12 \nrd_climon(a1,a2); then NT1 = a1, NT2 = a2, NT3 = 12\nrd_climo n(a1,a2,a3); then NT1 = a1, NT2 = a2, NT3 = a3\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 1993 "rd_climon:=proc() local rcf,NT1,NT2,NT3,nt1d,nt2d ,nt3d;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Decemb er 20, 2008`;\n#############################################\n### NT1 \+ = maximum allowed index value (default 9)\n### NT2 = maximum allowed g rade (default 4)\n### NT3 = maximum absolute value of coefficient allo wed (default 12)\nnt1d,nt2d,nt3d:=9,4,12:\n########################### ##################\nif nargs=0 then\n NT1,NT2,NT3:=nt1d,rand(0..nt2d )(),rand(1..nt3d)(): #defaults\nelif nargs=1 then\n if not type(args [1],nonnegint) or not evalb(args[1]<=9 and args[1]>= 0) then\n er ror \"argument must be non 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 arg s[1]>=0) or\n not evalb(args[2]<=args[1] and args[2]>=0)) t hen\nerror \"first argument must be non negative integer between 0 and 9 giving maximum monomial index. Second argument must be non negative integer between 0 and first argument giving maximum possible grade.\" \n end if;\n NT1,NT2,NT3:=args[1],min(args[1],args[2]),rand(1..nt3 d)():\nelif nargs>=3 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 argu ment must be non negative integer between 0 and 9 giving maximum monom ial index. Second argument must be non negative integer between 0 and \+ first argument giving maximum 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]:\nend if:\n#############\nrcf:=[rand(-NT3..-1)(), rand(1..NT3)()]:\nrcf:=rcf[rand(1..nops(rcf))()];\nreturn rcf*rd_cliba smon(NT1,NT2)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 92. Pro cedure " }{TEXT 476 13 "rd_clipolynom" }{TEXT -1 761 " generates a ran dom Grassmann polynomial. It can be used without any arguments in whic h case default values are used internally, or with 1, 2, 3, or 4 argum ents as follows:\n\nNT1 = maximum allowed index value (default 9)\nNT2 = maximum allowed grade (default 4)\nNT3 = maximum absolute value of \+ coefficients allowed (default 12)\nNT4 = maximum number of terms allo wed (default 4)\n\nrd_clipolynom(); 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, NT2 = a2, NT3 = a3, NT4 = 4\nrd_clipolynom(a1,a 2,a3,a4); then NT1 = a1, NT2 = a2, NT3 = a3, NT4 = a4\n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 3536 "rd_clipolynom:=proc() \nlocal rnt,rcf,NT1, nt1d,NT2,nt2d,NT3,nt3d,NT4,nt4d,L,newL,i,inde,x,m;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: December 20, 2008`;\n########### ##################################\n### NT1 = maximum allowed index va lue (default 9)\n### NT2 = maximum allowed grade (default 4) (must be \+ leq. than NT1)\n### NT3 = maximum absolute value of coefficient allowe d (default 12)\n### NT4 = 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..nt3d)(),rand(1..nt4d)(): #defaults\nelif nargs=1 t hen\n if not type(args[1],nonnegint) or not evalb(args[1]<=9 and arg s[1]>= 0) then\n error \"argument must be non negative integer be tween 0 and 9 giving the maximum monomial index\"\n end if;\n NT1, NT2,NT3,NT4:=args[1],rand(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 evalb(args[2]<=args[1] and args[2]>=0)) then\nerr or \"first argument must be non negative integer between 0 and 9 givin g maximum monomial index. Second argument must be non negative integer between 0 and first argument giving maximum possible grade.\"\n end if;\n NT1,NT2,NT3,NT4:=args[1],rand(0..min(args[1],args[2]))(),\n \+ rand(1..nt3d)(),rand(1..nt4d)(): \nelif nargs=3 the n\n if evalb(not type([args],list(nonnegint)) or \n not e valb(args[1]<=9 and args[1]>=0) or\n not evalb(args[2]<=arg s[1] and args[2]>=0)) then\nerror \"first argument must be non negativ e integer between 0 and 9 giving maximum monomial index. Second argume nt must be non negative integer between 0 and first argument giving ma ximum possible grade. Third argument must be a positive integer giving max value of coefficient.\";\n end if;\n NT1,NT2,NT3,NT4:=args[1] ,rand(0..min(args[1],args[2]))(),\n args[3],rand(1. .nt4d)():\nelif nargs>=4 then\n if evalb(not type([args],list(nonneg int)) 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 non negative integer between 0 and 9 giving maxim um monomial index. Second argument NT2 must be non negative integer be tween 0 and NT1 (inclusive) giving maximum possible grade. Third argum ent NT3 must be a positive integer giving max value of coefficient. Fo urth 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 arguments, if present, are ignored.\"\n end if:\n \+ NT1,NT2,NT3,NT4:=args[1],min(args[1],args[2]),args[3],args[4]:\nend \+ if:\n#############\n### NT1 = maximum allowed index value (default 9) \n### NT2 = maximum allowed grade (default 5)\n### NT3 = maximum absol ute value of coefficient allowed (default 12)\n### NT4 = maximum numbe r of terms allowed (default 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:=convert(L,list):\nnewL:=[[],[[]]]:\nnewL:=newL[r and(1..2)()]:\nfor i from 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);\ne nd do;\nL:=map(makeclibasmon,newL);\nrcf:=[rand(-NT3..-1)(),rand(1..NT 3)()]:\nreturn add(rcf[rand(1..nops(rcf))()]*L[i],i=1..nops(L))\nend p roc:\n" }}{PARA 258 "" 0 "" {TEXT -1 33 "No. 93. Initialization proced ure " }{TEXT 420 5 "setup" }{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 1651 "setup:=proc() \nlocal x,y,i,j;\nglobal libname ,B,\n_quatbasis,qi,qj,qk,\n_prolevel,\n_shortcut_in_minimalideal,\n_sh ortcut_in_Kfield,\n_shortcut_in_spinorKbasis,\n_shortcut_in_spinorKrep r,\ndim_V,\n_warnings_flag,\n_scalartypes,\n_CLIENV,\n_default_Cliffor d_product,\npause,\n###################################\n`convert/dfma trix`,`convert/mlist`,`convert/str_to_int`,`type/clibasmon`,\n`type/an tisymmatrix`,`type/climatrix`,`type/climon`,`type/clipolynom`,\n`type/ cliprod`,`type/cliprodpol`,`type/cliscalar`,`type/dfmatrix`,`type/diag matrix`,\n`type/evenelement`,`type/fieldelement`,`type/gencomplex`,`ty pe/genquatbasis`,\n`type/genquaternion`,`type/idempotent`,`type/nilpot ent`,`type/oddelement`,\n`type/primitiveidemp`,`type/purequatbasis`,`t ype/quaternion`,\n`type/symmatrix`,`type/tensorprod`,\n`&c`,`&cQ`,`&cQ m`,`&cm`,`&om`,`&q`,`&qm`,`&rm`,`&w`,`&wm`;\n######################### ##########\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: De cember 20, 2008`;\n################################################### ######\n_prolevel:=false: #assigning default value\n_sh ortcut_in_minimalideal:=true: #assigning default value\n_shortcut_in_K field:=true: #assigning default value\n_shortcut_in_spinorKbasis :=true: #assigning default value\n_shortcut_in_spinorKrepr:=true: #as signing default value\n_warnings_flag:=true: #assigning def ault value\ndim_V:=9: #default value\n_scalarty pes:=\{RootOf,mathfunc,function,numeric,rational,constant,indexed,comp lex,`^`\}:\n_CLIENV[_QDEF_PREFACTOR]:=-1:\n_default_Clifford_product:= cmulRS: #default Clifford product\n" }}{PARA 0 "" 0 "" {TEXT 371 98 "( 1) Global variable _scalartypes contains all types declared by the use r to be of type 'scalar'. \n" }}{PARA 258 "" 0 "" {TEXT -1 303 "(2) St andard quaternion basis as Maple global variable as in P. Lounesto \"C lifford Algebras and Spinors\", page 49. To avoid conflicts with i, j , k, etc. traditionally used in summations, loops, user could define q i, qj, and qk in place of \{i, j, k\} used to denote pure quaternion p art of a quaternion.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 "_quatbasi s:=[[Id,e3we2,e1we3,e2we1],\{`Maple has assigned qi:=-e2we3, qj:=e1we3 , qk:=-e1we2`\}];\n" }}{PARA 0 "" 0 "" {TEXT 367 48 "(3) Defining abbr eviations for quaternion basis:" }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 "unprotect(qi,qj,qk);\nqi:=-e2we3:\nqj:=e1we3:\nqk:=-e 1we2:\n" }}{PARA 0 "" 0 "" {TEXT 368 31 "(4) Defining useful functions :\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 "pause:=proc(s::nonnegint) lo cal s1:\ns1:=time():\nwhile 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. Definition of the type " }{TEXT 436 9 "clibasmon" } {TEXT -1 87 ", i.e., a basis monomial. \n\nTypical use: type(e2we1,cli basmon); type(e1we2,clibasmon);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 946 "`type/clibasmon`:=proc(a)\nlocal a1,i,str,lst,e_set,w_set,ind_lst ,N;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: December \+ 20, 2008`;\n#############################################\n#a1:=simpli fy(eval(a)):\na1:=eval(a): #no simplify here\n if a1 = Id then retur n 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_se t:=\{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 true\n el se\n return false \n end if:\n else\n return false \n \+ end if: \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 30 "No. 2. Defi nition of the type " }{TEXT 437 9 "cliscalar" }{TEXT -1 255 ", i.e., C lifford scalar. A Clifford scalar is essentially any number, function, constant, or an algebraic expression not containing any basis monomia ls (this means that 2*Id is not of type 'cliscalar').\n\nTypical use: \+ type(e1+e2we3+2*Pi*B[1,2],cliscalar);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 764 "`type/cliscalar`:=proc(a::anything) local a1,locscalartypes; \nglobal `&C`,_scalartypes; \noptions `Copyright (c) 1995-2009 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n################################# ############\na1:=simplify(eval(a)):\nlocscalartypes:=remove(member,_s calartypes,\{`^`\}):\nif type(a1,\{matrix,list\}) or hastype(a1,clibas mon) or \n hastype(a1,tensorprod) or has(a1,`&C`) then return false \+ \nend if: \nif type(a1,locscalartypes) or evalb(op(map(type,\{op(a1) \},locscalartypes))=true)\n then return true \nend if:\nif type(a1, `^`) then\n if select(hastype,\{a1\},clibasmon)=\{\} then\n ret urn true else error \"illegal expression in %1\",a1 \n end 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 essentially any basis monomial (of type 'clibasmon') multiplied by a Clifford scalar \+ (of type 'cliscalar').\n\nTypical use: type(e1we2+2*e2,climon);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 762 "`type/climon`:=proc(x1) local x,S, xx,flag6plus:\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz an d Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n#############################################\nx :=simplify(eval(x1)):\nflag6plus:=assigned(Cliplus):\nif hastype(x,cli prod) and not flag6plus and _warnings_flag then \n WARNING(`argument to 'type/climon' contains type 'cliprod'. Load 'Cliplus' to extend f unctionality of CLIFFORD. Type ?cliprod for help.`);\nend if:\n####### ###########\nif not flag6plus then S:=\{'clibasmon'\} else S:=\{'cliba smon','cliprod'\} end if:\nxx:=simplify(x):\nif type(xx,cliscalar) the n 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 "clipo lynom" }{TEXT -1 265 ", i.e., Clifford polynomial. A Clifford polynom ial is a multivariate polynomial in the unknowns of type 'climon' or ' cliprod', i.e., Clifford monomial, with coefficients of the type 'clis calar', i.e., Clifford scalar.\n\nTypical use: type(e1+2*Pi*e2we3,clip olynom);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 980 "`type/clipolynom`:=p roc(x1) local x,flag6plus:\noptions `Copyright (c) 1995-2009 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: December 20, 2008`;\n################################### ##########\n#x:=simplify(eval(x1)):\nx:=eval(x1): #no somplify here\ni f type(eval(x),\{matrix,list,set,cliscalar\}) or \n (not type(eval(x),algebraic)) or \n hastype(eval(x),tensor prod) then \nreturn false \nend if:\nflag6plus:=assigned(Cliplus):\ni f hastype(x,cliprod) and not flag6plus and _warnings_flag then \n WA RNING(`argument to 'type/clipolynom' contains type 'cliprod'. Load 'Cl iplus' to extend functionality of CLIFFORD. Type ?cliprod for help.`) ;\nend if:\nif evalb(not flag6plus and type(expand(x),`+`) and hastype (x,clibasmon) and not hastype(x,cliprod)) \n then return true \nend if:\nif evalb(flag6plus and type(expand(x),`+`) and hastype(x,\{cliba smon,cliprod\})) then \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: map(convert,extract(e1we2),str_to_int);\n" } {MPLTEXT 0 21 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 648 "`convert/str_ to_int`:=proc(a1::symbol)\noptions `Copyright (c) 1995-2009 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`,remember;\ndescr iption `Last revised: December 20, 2008`;\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 retur n 2 elif\n args[1] = `3` then return 3 elif\n args[1] = `4` then r eturn 4 elif\n args[1] = `5` then return 5 elif\n args[1] = `6` th en return 6 elif\n args[1] = `7` then return 7 elif\n args[1] = `8 ` then return 8 elif\n args[1] = `9` then return 9 else\n return a 1\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 6. Defin ition of type " }{TEXT 442 9 "nilpotent" }{TEXT -1 914 ". The followi ng procedure verifies whether or not its non-zero argument is a nilpot ent element in the given Clifford algebra Cl(B). It is expected that \+ a matrix of the bilinear form B has been specified. If the element h appens to be an idempotent, or if some power of that element equals th e element itself, or if the element is of type 'cliscalar' then the pr ocedure returns 'false'. Otherwise, the procedure checks if any powe r of its argument up to and including order of 2^N, where N is the max imum index found in the input, is zero.\n\nThis procedurecan also test for nilpotency w.r.t. to a name/symbol/matrix/array which may be pass ed on as a second element of 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) \nt ype(p,nilpotent);\ntype([p,K],nilpotent);\ntype([p,-K],nilpotent);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2104 "`type/nilpotent`:=proc(a11) \nl ocal a1,i,x,y,xx,k,flagB,S,lname,flagindexed;global B;\noptions `Copyr ight (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: December 20, 2008`;\n####### ######################################\n############################## ############\n##This 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 ent er p, or, [p,B].\n##########################################\nif type( a11,\{cliscalar,clibasmon,climon,clipolynom\}) then\n a1:=a11:\n l name:=`B`:\n flagindexed:=false:\n if not type(B,matrix) then e rror \"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 elements\"\n elif no t type(a11[1],\{cliscalar,clibasmon,climon,clipolynom\}) or\n \+ not type(a11[2],\{name,symbol,matrix,array,`&*`(numeric,\{name,symbo l,matrix,array\})\})\n then error \"list must contain clipolynom \+ and name\"\n else\n a1:=a11[1]:\n lname:=a11[2]:\n flagindexed :=true:\n if not type(evalm(lname),matrix) then error \"matrix mu st be assigned to %1\",lname \n else flagB:=type(evalm(lnam e),diagmatrix) \n end if: \n end if:\nelse\n error \"unexpect ed argument type\"\nend if:\n###################################\nx:=d isplayid(a1):\nif a1=0 then return true \n elif type(a1,cliscalar) \+ then \n return false \n elif (type(x,clibasmon) and fla gB and linalg[det](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(solve(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 false end if: \n y:=cmul(x,y);\n if y=0 the n return true end if:\n end do:\nerror \"Sorry, but I am unable \+ to determine nilpotency of %1\",a1\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 7. Definition of type " }{TEXT 443 10 "idempotent" } {TEXT -1 311 ". The following procedure verifies whether or not its a rgument is an idempotent in the given Clifford algebra Cl(B). It is e xpected that a matrix of the bilinear form B has been specified. It ca n also check element p for being idempotent in Cl(K) if K is entered a s 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 1578 "`type/idempotent`:=proc(a11) \nlocal f,ff,lname,a1,flagindexed,f lagB; global B;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: December 20, 2008`;\n############################################# \n##########################################\n##This code allows for p assing name of the matrix K as a second element in a list:\n##To test \+ element p for being idempotent w.r.t. matrix K enter [p,K];\n##To test element p for being idempotent w.r.t. B enter p, or, [p,B].\n######## ##################################\nif type(a11,\{cliscalar,clibasmon, climon,clipolynom\}) then\n a1:=a11:\n lname:=`B`:\n flagindexed :=false:\n if not type(B,matrix) then error \"matrix must be assi gned to B\" \n else flagB:=type(B,diagmatrix) \n end i f:\nelif type(a11,list) then\n if nops(a11)<>2 then error \"list mus t have exactly two elements\"\n elif not type(a11[1],\{cliscalar, clibasmon,climon,clipolynom\}) or\n not type(a11[2],\{name,s ymbol,matrix,array,`&*`(numeric,\{name,symbol,matrix,array\})\})\n \+ then error \"list must contain clipolynom and name\"\n else\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\",lna me \n else flagB:=type(evalm(lname),diagmatrix) \n end if: \n end if:\nelse\n error \"unexpected argument type\"\nend if :\n########################################\nf:=displayid(a1):\nff:=cm ul[lname](f,f):\nif evalb(ff=0) then return false end if:\nreturn eval b(simplify(ff-f)=0)\nend 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 Ma ple that has been defined via the procedure linalg[matrix] is of the s tandard Maple type 'matrix' including matrices with entries in a Cliff ord 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 have at least one entry in a Clifford algebra." }} {PARA 258 "" 0 "" {TEXT -1 208 "\nMatrices of the type 'matrix' but no t 'climatrix' may be multiplied using standard Maple matrix multiplica tion operator `&*`.\n\nMatrices of the type 'climatrix' must be multip lied using the procedure 'rmulm'." }}{PARA 0 "" 0 "" {TEXT 430 104 "\n Typical use: M:=linalg[matrix](2,2,[e1,e3we4+e3,e4,Id-e1]);\n \+ type(M,climatrix);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 356 "`type/climatrix`:=proc(x)\noptions `Copyright (c) 1995-2009 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: December 20, 2008`;\n############################### ##############\nif type(x,array) then\n return evalb(select(type,conv ert(x,set),\{clipolynom,climon,clibasmon\})<>\{\})\nelse \n return fa lse\nend if:\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 429 37 "No. 9. Usef ul conversion function to " }{TEXT 445 5 "mlist" }{TEXT 446 20 " neede d by 'rmulm'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 369 "`convert/mlist` :=proc(a1::matrix) local i,longlist;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndes cription `Last revised: December 20, 2008`;\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 "fieldelement" }{TEXT 448 2 ":\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 548 "`type/fieldelement`:=proc(a1::algebraic) global f; \+ \noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n#############################################\nif not assigne d(f) then \n error \"primitive idempotent f has not been assigned ye t\" \nend if:\nif not type(f,primitiveidemp) then \n error \"althoug h f has been assigned, it is not of type/primitiveidemp\"\nend if:\nif member(squaremodf(args[1],f),\{-1,1\}) then return true else return f alse end if \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 427 20 "No. 11. A n ew type: " }{TEXT 449 9 "symmatrix" }{TEXT 450 25 " - a symmetric ma trix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 470 "`type/symmatrix`:=proc( a1::\{name,symbol,matrix,`&*`(algebraic,matrix)\}) \noptions `Copyrigh t (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: December 20, 2008`;\n########## ###################################\nif evalb(evalm(a1)=a1) then retur n false end if:\nif linalg[coldim](a1)<>linalg[rowdim](a1) then\n er ror \"B must be assigned square matrix\" \nend if:\nreturn linalg[equa l](a1,linalg[transpose](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 475 "`type/antisymmatrix`:=proc(a1::\{name,symbol,matrix, `&*`(algebraic,matrix)\}) \noptions `Copyright (c) 1995-2009 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: December 20, 2008`;\n################################### ##########\nif evalb(evalm(a1)=a1) then return false end if:\nif linal g[coldim](a1)<>linalg[rowdim](a1) then\n error \"B must be assigned \+ square matrix\" \nend if:\nreturn linalg[equal](a1,-linalg[transpose]( a1))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 425 20 "No. 13. A new type: " }{TEXT 453 10 "diagmatrix" }{TEXT 454 25 " - a diagonal matrix. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 483 "`type/diagmatrix`:=proc(a1:: anything) local N,i,DD;\noptions `Copyright (c) 1995-2009 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: December 20, 2008`;\n###################################### #######\nif not type(a1,\{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 r eturn linalg[iszero](evalm(a1-DD))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. New type: " }{TEXT 455 14 "primitiveidemp" } {TEXT -1 1109 " - primitive idempotent. This procedure determines the number of factors in the given 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 Id. \nIt returns 'true' if n = q - RHnumbe r(q-p), where 'RHnumber' is the Radon-Hurwitz function and [p,q] is si gnature of the current quadratic form which is assumed to have been de fined, i.e., the bilinear form B has been defined as a diagonal matrix , and 'false' if n < q - RHnumber(q-p).\n\nIf the argument is the iden tity element 'Id' of the algebra Cl(Q), the procedure checks if Cl(Q) \+ is simple or semi-simple, and it returns 'true' or 'false' respectivel y. It is known that when Cl(Q) is semi-simple, 'Id' can be written as a sum of mutually annihilating idempotents (1/2)*(Id+p) and (1/2)*(Id -p), where p is the unit pseudo-scalar element (volume element) in Cl( Q).\n\nThe procedure expects that the bilinear form B has been defined as a diagonal matrix.\n\nTypical use: type(cmul((1/2)*(Id+e1),(1/2)*( Id+e2we3we4we5),primitiveidemp);\n type(Id,pri mitiveidemp);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 509 "`type/primitive idemp`:=proc(f::idempotent) local p,q,numfact;global B;\noptions `Copy right (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`;\ndescription `Last revised: December 20, 2008`;\n###### #######################################\nif not type(B,matrix) then \n error \"B must be assigned square matrix\" \nelse\n p:=Bsignature (B)[1]:q:=Bsignature(B)[2]\nend if:\nnumfact:=q-RHnumber(q-p):\nif sca larpart(f)=1/2^numfact then \n return true \nelse \n return false \+ \nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 13 "No. 15. Type \+ " }{TEXT 456 13 "purequatbasis" }{TEXT -1 109 " is a procedure which c hecks if the given list of three basis monomials can be a basis for pu re quaternions.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 921 "`type/purequa tbasis`:=proc(l1::list(\{clibasmon,climon,clipolynom\})) \nlocal p,q,r ;global B;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: De cember 20, 2008`;\n#############################################\nif n ops(l1) <> 3 then \n error \"list must have exactly 3 elements of ty pe 'clibasmon', 'climon', 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 th en return false elif\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 return false elif\n cmul(p,r)+cmul(r,p)<>0 then return \+ false elif\n cmul(q,r)+cmul(r,q)<>0 then return false else\n retur n true\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 16. A new type: " }{TEXT 457 10 "gencomplex" }{TEXT -1 413 " - a generali zed complex 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 compl ex numbers C. Knowing that the given polynomial p is of that type allo ws for finding the inverse of p in A < Cl(B) a more efficient way by t he procedure 'cinv'.\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 887 "`type/gencomplex`:=proc(a1::\{cliscalar,cliba smon,climon,clipolynom\}) local L;global B;\noptions `Copyright (c) 19 95-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: December 20, 2008`;\n################## ###########################\nif not type(B,matrix) then \n error \"c an't check type since B is not assigned a matrix\" \nend if:\nif type( a1,cliscalar) then 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] th en 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[coldi m](B) then \n error \"can't check type since the largest index in %1 is greater than size %2 of current form B\", a1,linalg[coldim](B)\nen d 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. 1 7. A new type: " }{TEXT 458 13 "genquaternion" }{TEXT -1 513 " - a gen eralized quaternionic 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) isomorphi c to a division ring H of quaternions. Knowing that the given polynom ial p is of that type allows for finding the inverse of p in A < Cl(B) a more efficient way by the procedure 'cinv'.\n\nNote that elements o f grade 0 (eg., 2*Id) and elements of type 'gencomplex' - a generalize d complex element of Cl(B), are not of this type.\n\nTypical use: type (p,genquaternion);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 664 "`type/genq uaternion`:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local \+ L;global B;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: D ecember 20, 2008`;\n#############################################\nif \+ not type(B,matrix) then \n error \"square matrix must be assigned to B\" \nend if:\nif type(a1,cliscalar) then return false end if:\nL:=[o p(cliterms(reorder(a1)))];\nif nops(L)>4 or type(a1,gencomplex) then r eturn false end if:\nL:=remove(member,L,[Id]);\nif nops(L)=1 then retu rn 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. 18/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 a re even elements, odd elements, or neither in Cl(B).\n\nTypical use: t ype(p,evenelement);\n type(p,oddelement);\n\nwhere \+ p is a Clifford polynomial.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 777 "` type/evenelement`:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) \noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n#############################################\nif type(eval(a 1),cliscalar) then return true end if:\nreturn evalb(reorder(displayid (eval(a1)-gradeinv(eval(a1))))=0)\nend proc:\n\n`type/oddelement`:=pro c(a1::\{cliscalar,clibasmon,climon,clipolynom\})\noptions `Copyright ( c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: December 20, 2008`;\n############# ################################\nif type(eval(a1),cliscalar) then ret urn false end if:\nreturn evalb(reorder(displayid(eval(a1)+gradeinv(ev al(a1))))=0)\nend 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 897 "`type/quaternion`:=proc(q::algebraic) local aa1 ,aa2,S;global B,qi,qj,qk;\noptions `Copyright (c) 1995-2009 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: December 20, 2008`;\n#################################### #########\nif not assigned(B) or not type(B,matrix) then \n error \" bilinear form B has not been assigned yet. It must be defined as the i dentity 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\" \+ \nend if:\nif not type(eval(q),\{'clibasmon','climon','clipolynom'\}) \+ then \n error \"wrong input type: input must be of type 'clibasmon', 'climon', or 'clipolynom'\" \nend if:\naa1:=\{op(cliterms(reorder(expa nd(eval(q)))))\};\naa2:=\{Id,e1we2,e1we3,e2we3\};#standard basis to be compared to\nS:=aa1 minus aa2;\nif op(S) = NULL then \n return true else 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 Ten sor Product'. This is an experimental package for computations with g raded tensor products of Clifford algebras." }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 333 "`type/tensorprod`:=proc(a1::anything)\no ptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: December 20, 20 08`;\n#############################################\nif type(a1,functi on) and op(0,a1)=`&t` then return true else return false end if:\nretu rn 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 "g enquatbasis" }{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\}, genqu atbasis);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1476 "`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-2009 \+ by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n#### #########################################\ndescription `Last revised: \+ December 20, 2008`;\nif nops(L) <> 4 or nops(L)<>nops(convert(L,set)) \+ then \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 \+ the 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 c mul(q,q)<>cmul(-Id,f) then return false elif\n cmul(k,k)<>cmul(-Id,f ) then return false \nend if:\n################################## \n if (cmul(p,q)=cmul(k,f) and cmul(q,p)=-cmul(k,f) and \n cmul(q,k)=c mul(p,f) and cmul(k,q)=-cmul(p,f) and \n cmul(k,p)=cmul(q,f) and cm ul(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 \+ cmul(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 480 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),c liprod); type(`&C`[K](e1,e2),cliprod); type(&C(e1,e2),cliprod);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 317 "`type/cliprod`:=proc(f::\{function ,anything\}) local p;\noptions `Copyright (c) 1995-2009 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: December 20, 2008`;\n######################################## #####\nevalb(member(op(0,f),\{`&C`\}) or member(op(0,op(0,f)),\{`&C`\} ))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 172 "No. 24: New type: cli prodpol\n\nA Clifford polynomial expressed in Clifford basis. That is, a polynomial that is a sum of monomials of type 'cliprod' or 'cliscal ar*cliprod'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 379 "`type/cliprodpol `:=proc(f::\{function,anything\}) local p;\noptions `Copyright (c) 199 5-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.` ;\ndescription `Last revised: December 20, 2008`;\n################### ##########################\nif patmatch(f,a::cliscalar*b::cliprod) the n return false end if:\nif type(f,\{`+`\}) then return hastype(f,clipr od) end if;\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 433 18 "No. 25. Proc edure " }{TEXT 469 16 "convert/dfmatrix" }{TEXT 470 84 " converts a li st of matrices or a pair of matrices inot a matrix over double field. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 969 "`convert/dfmatrix`:=proc() l ocal l1,l2,L,i,j,m,n,m1,m2,MN;\noptions `Copyright (c) 1995-2009 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: December 20, 2008`;\n############################### ##############\nif nargs=1 and type(args[1],dfmatrix) \n \+ then return args[1]\nelif nargs=1 and type(args[1],list(\{matrix,arra y\})) \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 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 := linalg[rowdim](m1);\n n := linalg[rowdim](m1);\n MN := linal g[matrix](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. 26. Procedure " } {TEXT 471 13 "type/dfmatrix" }{TEXT 472 73 " checks if a matrix is of \+ type 'dfmatrix', that is, over a double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 497 "`type/dfmatrix`:=proc(m::anything) local mm;\noption s `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. A ll rights reserved.`;\ndescription `Last revised: December 20, 2008`; \n#############################################\nif not type(m,matrix) and not type(m,list(matrix)) then return false end if:\nif type(m,mat rix) then \n return type(convert(m,mlist),\n list(list(\{cl iscalar,clibasmon,climon,clipolynom,numeric,symbol,algebraic\})))\nels e\n return false\nend if:\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 477 79 "In this version we define all ampersand operators as global in Cli fford:-setup:" }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2305 "`&c`:=proc() local NP,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. Al l rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n #############################################\n####################### ################\n### Works when &c[''K''] or &c[''-K''] is entered an d K is a matrix\n#######################################\nflagdec:=tru e:\nif type(op(procname),procedure) then\n if type([args],listlist) \+ then\n if type(op(args),array) then\n WARNING(\"enclose i ndex in double quotes as in &c[''B''] or &c[''-B''] when B has been as signed a matrix to avoid the following:\");\n return 'procname( args)';\n end if;\n else coB:=1:\n nameB:=`B`:\n lna me:=`B`:\n ARGS:=[args]:\n flagdec:=false:\n end if;\nel se lname:=op(procname);\n ARGS:=[args];\n if type(lname,`&*`(n umeric,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 type(op(args),function) then\n ARGS:=op(op(args));\n c oB:=1:\n nameB:=eval(op(0,op(args)));\n if type(nameB,`&*`(n umeric,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 n ameB:=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 determ ine arguments and/or index from arguments\"\n end if;\nreturn coB,name B,[ARGS];\nend proc:\n#####################################\nif flagde c then \n coB,nameB,ARGS:=decindex(args);\n lname:=coB*nameB;\nend if;\nNP:=nops(ARGS);\nif member(0,ARGS) then return 0 end if;\nif NP \+ <=1 then return op(ARGS) end if;\nreturn cmul[eval(lname)](op(ARGS)); \+ \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2381 "`&cQ`:=proc() lo cal NP,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyright (c) \+ 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: December 20, 2008`;\n################ #############################\n####################################### \n### Works when &cQ[''K''] or &cQ[''-K''] is entered and K is a matri x\n#######################################\nflagdec:=true:\nif type(op (procname),procedure) then\n if type([args],listlist) then\n if type(op(args),array) then\n WARNING(\"enclose index in double quotes as in &cQ[''B''] or &cQ[''-B''] when B has been assigned a mat rix 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 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:\n en d if;\n#######################################\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif type([args],listlist) then\n if type(o p(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(sel ect(type,nameB,function));\n ARGS:=op(nameB);\n nameB:=op(0, nameB);\n else\n error \"unable to determine index from or wron g index, use name in double quotes as in &cQ[''B''] or &cQ[''-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\"\nend if;\nreturn coB,nameB,[ARGS ];\nend proc:\n#####################################\nif flagdec then \+ \n coB,nameB,ARGS:=decindex(args);\n lname:=coB*nameB;\nend if;\nN P:=nops(ARGS);\nif member(0,ARGS) then return 0 end if;\nif NP <=1 the n return op(ARGS) end if;\nreturn cmul[eval(lname)](op(ARGS));\n#retur n cmulQ[eval(lname)](op(ARGS)); ###Causes an error in `&cQ` \nend proc :\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1856 "`&cQm`:=proc() local ARGS, lname,NP,coB,nameB,decindex;\noptions `Copyright (c) 1995-2009 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2008`;\n################################# ############\n#######################################\nif type([args], listlist) then\n if type(op(args),array) then\n WARNING(\"enclo se index in double quotes as in &cQm[''B''] or &cQm[''-B''] when B has been assigned a matrix to avoid the following:\");\n return ('pr ocname(args)');\n end if;\nend if;\n################################ #######\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif type([arg s],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 i f type(nameB,`&*`(numeric,name)) then\n coB:=op(select(type,\{ op(nameB)\},numeric));\n nameB:=op(select(type,\{op(nameB)\},n ame));\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(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 &cQm, try enclosing name of the index in double quotes as in &cQm[''B''] or &cQm[''-B'']\"\n en d if;\nelif\n type([args],list) then\n ARGS:=args;\n coB:=1:\n \+ nameB:=`B`; #default name \nelse\n error \"cannot determine argumen ts and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc:\n##### ################################\ncoB,nameB,ARGS:=decindex(args);\nlna me:=coB*nameB:\n NP:=nops(ARGS);\n if member(0,ARGS) then return 0 e nd 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 proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2448 "`&cm`:=proc() local N P,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyright (c) 1995- 2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: December 20, 2008`;\n#################### #########################\n#######################################\n## # Works when &cm[''K''] or &cm[''-K''] is entered and K is a matrix\n# ######################################\nflagdec:=true:\nif type(op(pro cname),procedure) then\n if type([args],listlist) then\n if typ e(op(args),array) then\n WARNING(\"enclose index in double quo tes as in &cm[''B''] or &cm[''-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 lname:= op(procname);\n ARGS:=[args];\n if type(lname,`&*`(numeric,nam e)) then\n coB:=op(select(type,\{op(lname)\},numeric));\n \+ nameB:=op(select(type,\{op(lname)\},name));\n else\n c oB:=1:\n nameB:=lname:\n end if;\n flagdec:=false:\ne nd if;\n#######################################\ndecindex:=proc() loca l 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 eli f type(op(args),`&*`(numeric,function)) then\n nameB:=\{op(op(arg s))\}:\n coB:=op(select(type,nameB,numeric));\n nameB:=op(se lect(type,nameB,function));\n ARGS:=op(nameB);\n nameB:=op(0 ,nameB);\n else\n error \"unable to determine index or wrong in dex: use name in double quotes as in &cm[''B''] or &cm[''-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\"\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, lname,ARGS);\nNP:=nops(ARGS);\n if member(0,ARGS) then return 0 end i f;\n if NP <=1 then \n return op(ARGS)\n elif NP = 2 then \n \+ return rmulm(eval(ARGS[1]),eval(ARGS[2]),cmul,lname) \n else\n e rror \"only two arguments and index are allowed\"\n end if;\nend proc :\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 233 "`&q`:=proc()\noptions `Copy right (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`;\ndescription `Last revised: December 20, 2008`;\n###### #######################################\nreturn qmul(args) \nend proc: \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 466 "`&qm`:=proc() local NP: \nop tions `Copyright (c) 1995-2009 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`;\ndescription `Last revised: December 20, 200 8`;\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]),ev al(args[2]),qmul) \n else\n error \"only two arguments are allowe d in &qm\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 350 "`&om`:=proc()\noptions `Copyright (c) 1995-2009 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: December 20, 2008`;\n########################################### ##\nif not assigned(Octonion) then\n error \"package 'Octonion' must be loaded first\"\nend if;\nreturn subs(Id=1,rmulm(args,Octonion:-omu l))\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1848 "`&rm`:=proc() local ARGS,lname,NP,coB,nameB,decindex;\noptions `Copyright (c) 1995- 2009 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: December 20, 2008`;\n#################### #########################\n#######################################\nif type([args],listlist) then\n if type(op(args),array) then\n WA RNING(\"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(selec t(type,\{op(nameB)\},numeric));\n nameB:=op(select(type,\{op(n ameB)\},name));\n end if;\n elif type(op(args),`&*`(numeric,fu nction)) then\n nameB:=\{op(op(args))\}:\n coB:=op(select(ty pe,nameB,numeric));\n nameB:=op(select(type,nameB,function));\n \+ ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n error \+ \"unable to determine index or wrong index type for &rm, try enclosing 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 467 "`&w m`:=proc() local NP: \noptions `Copyright (c) 1995-2009 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: December 20, 2008`;\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 retu rn rmulm(eval(args[1]),eval(args[2]),wedge) \n else\n error \"onl y 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 8 "libname;" }} {PARA 11 "" 1 "" {XPPMATH 20 "6$Q7C:\\Maple12/Cliffordlib6\"Q/C:\\Mapl e12/libF$" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 70 "#march('delete ',libname[1],Clifford);\n#march('create',libname[1],500);" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 11 "libname[1];" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q7C:\\Maple12/Cliffordlib6\"" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 "savelib('Clifford'):\n" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 28 "march('listdir',libname[1]);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#7#7&QAC:\\Maple12/Cliffordlib\\maple.lib6\"7(\"%3?\"#7 \"#?\"#;\"\"*\"#=Q)WRITABLEF&\"\"!" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 59 "Let's add library files to the main library in libname[1]:\n" } }}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 455 "march('add',libname[1],`C :\\\\Maple12/Clifforddata/matrealL.m`,`matrealL.m`);\nmarch('add',libn ame[1],`C:\\\\Maple12/Clifforddata/matrealR.m`,`matrealR.m`);\nmarch(' add',libname[1],`C:\\\\Maple12/Clifforddata/matcompL.m`,`matcompL.m`); \nmarch('add',libname[1],`C:\\\\Maple12/Clifforddata/matcompR.m`,`matc ompR.m`);\nmarch('add',libname[1],`C:\\\\Maple12/Clifforddata/matquatL .m`,`matquatL.m`);\nmarch('add',libname[1],`C:\\\\Maple12/Clifforddata /matquatR.m`,`matquatR.m`);" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, m ember \"matrealL.m\" already in archive, skipping\n" }}{PARA 7 "" 1 " " {TEXT -1 58 "Warning, member \"matrealR.m\" already in archive, skip ping\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matcompL.m\" \+ already in archive, skipping\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning , member \"matcompR.m\" already in archive, skipping\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matquatL.m\" already in archive, s kipping\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matquatR.m \" already in archive, skipping\n" }}}{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$\"\"#F%7#7$\"\")\"\"!7#7$\"\"\"F,7#7$\"\"*F)7#7$F,F (7#7$\"\"%F%7#7$F)\"\"(7#7$F4\"\"$7#7$F%F)7#7$F)\"\"'7#7$F:F:7#7$F:F%7 #7$\"\"&F:7#7$F:F,7#7$F,F77#7$F4F47#7$FFF47#7$F)F(7#7$F%F," }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matrealR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"#F%7#7$\"\")\"\"!7#7$\"\"\"F,7#7$\"\"*F)7# 7$F,F(7#7$\"\"%F%7#7$F)\"\"(7#7$F4\"\"$7#7$F%F)7#7$F)\"\"'7#7$F:F:7#7$ F:F%7#7$\"\"&F:7#7$F:F,7#7$F,F77#7$F4F47#7$FFF47#7$F)F(7#7$F%F," }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matcompL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\"'\"\"$7#7$\"\"%\"\"\"7#7$\"\"#\"\"(7 #7$F.\"\"!7#7$F*F-7#7$F)\"\"&7#7$F*F%7#7$F-F&7#7$F&F17#7$\"\")F*7#7$F6 F-7#7$F1\"\"*7#7$F&F)7#7$F1F6" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matcompR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\"' \"\"$7#7$\"\"%\"\"\"7#7$\"\"#\"\"(7#7$F.\"\"!7#7$F*F-7#7$F)\"\"&7#7$F* F%7#7$F-F&7#7$F&F17#7$\"\")F*7#7$F6F-7#7$F1\"\"*7#7$F&F)7#7$F1F6" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matquatL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"'\"\"\"7#7$\"\"&\"\"!7#7$F&\"\"$7#7$ F)F&7#7$\"\"(F&7#7$\"\"#\"\"%7#7$F&F)7#7$F6F*7#7$F*F57#7$F2F57#7$F%F*7 #7$F*F67#7$F5F%7#7$F%F57#7$F*F-7#7$F&F67#7$F-F%7#7$F-F)7#7$F5F)" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matquatR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"'\"\"\"7#7$\"\"&\"\"!7#7$F&\"\"$7#7$ F)F&7#7$\"\"(F&7#7$\"\"#\"\"%7#7$F&F)7#7$F6F*7#7$F*F57#7$F2F57#7$F%F*7 #7$F*F67#7$F5F%7#7$F%F57#7$F*F-7#7$F&F67#7$F-F%7#7$F-F)7#7$F5F)" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 258 "" 0 " " {TEXT -1 989 "Last revised: December 20, 2008\n\nNOTES:\n\n1. The ta ble name, e.g., Clifford, and the file name, e.g., Clifford.m must be \+ the same.\n2. March commands useful in creating and viewing library fi le (issue in DOS window):\n\nC:\\Maple11>bin.wnt\\march -c Cliffordlib 20 - creates library in a existing empty directory \\Cliffordlib\n C:\\Maple11>bin.wnt\\march -l Cliffordlib - list all entries in the l ibrary Cliffordlib\nC:\\Maple11>bin.wnt\\march -l Cliffordlib > list.t xt - list all entries in the library Cliffordlib and write them into \+ file list.txt\nC:\\Maple11>bin.wnt\\march -d Cliffordlib Clifford.m - \+ delete Clifford.m from the library Cliffordlib\n\n3. Global variable \+ savelibname is empty, but savelib() automatically assigns libname[1] t o savelibname for the purpose of saving package there with the command savelib().\n4. Maple initialization file maple.ini contains libname a ugmented by the path and the directory name \\Cliffordlib where the Cl ifford library with Clifford.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',Cliffordlib,500);\n###savelib(Clifford,`Clifford.m`) :\n########################################################" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 "restart:with(Clifford);" }} {PARA 12 "" 1 "" {XPPMATH 20 "6#7`p%#&mG%+BsignatureG%-CLIFFORD_ENVG%' KfieldG%#LCG%$LCQG%#RCG%$RCQG%)RHnumberG%*adfmatrixG%)all_sigsG%+beta_ minusG%*beta_plusG%'buildmG%(bygradeG%)c_conjugG%'cbasisG%*cdfmatrixG% %cexpG%&cexpQG%%cinvG%,clibilinearG%+clicollectG%(clidataG%*clilinearG %+climinpolyG%)cliparseG%*cliremoveG%)clisolveG%(clisortG%)clitermsG%% cmulG%(cmulNUMG%&cmulQG%'cmulRSG%(cmulgenG%(cocycleG%2commutingelement sG%,conjugationG%*ddfmatrixG%,diagonalizeG%*displayidG%(extractG%1fact oridempotentG%)find1strG%*findbasisG%)gradeinvG%%initG%/isVahlenmatrix G%*isproductG%,makealiasesG%.makeclibasmonG%)matKreprG%)maxgradeG%)max indexG%*mdfmatrixG%-minimalidealG%$ordG%)permsignG%*pseudodetG%)q_conj ugG%)qdisplayG%%qinvG%%qmulG%&qnormG%-rd_clibasmonG%*rd_climonG%.rd_cl ipolynomG%(reorderG%*reversionG%&rmulmG%&rot3dG%+scalarpartG%%sexpG%2s pecify_constantsG%-spinorKbasisG%,spinorKreprG%+squaremodfG%0subs_clip olynomG%+useproductG%+vectorpartG%(versionG%&wedgeG%%wexpG" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 "version();" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%L+++++++++++++++++++++++++++++++++++++++++++G" }} {PARA 11 "" 1 "" {XPPMATH 20 "6#%]oCLIFFORD~-~A~Maple~12~Package~for~C lifford~Algebras~with~\"Bigebra\"G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6# %\\o(Version~12~with~environmental~variables~given~by~CLIFFORD_ENV())G " }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%]oLast~revised:~December~20,~2009 ~(Source~file:~clifford_M12_12.mws)G" }}{PARA 11 "" 1 "" {XPPMATH 20 " 6#%_oCopyright~1995-2009~by~Rafal~Ablamowicz~(*)~and~Bertfried~Fauser~ ($)G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%!G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%H(*)~Department~of~Mathematics,~Box~5054G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%gn~~~~Tennessee~Technological~University,~Cook eville,~TN~38505G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%U~~~~tel:~USA~(9 31)~372-3569,~fax:~USA~(931)~372-6353G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%;~~~~rablamowicz@tntech.eduG" }}{PARA 11 "" 1 "" {XPPMATH 20 "6 #%B~~~~http://math.tntech.edu/rafal/G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%Y($)~Universit\"at~Konstanz,~Fachbereich~Physik,~Fach~M678G" }} {PARA 11 "" 1 "" {XPPMATH 20 "6#%<~~~~78457~Konstanz,~GermanyG" }} {PARA 11 "" 1 "" {XPPMATH 20 "6#%E~~~~Bertfried.Fauser@uni-konstanz.de G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%R~~~~http://kaluza.physik.uni-ko nstanz.de/|irfauser/G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%!G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%boIf~you~are~a~Clifford~algebra~pro,~assign ~'true'~to~'_prolevel'~and~seeG" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%\\ ohow~much~faster~your~computations~will~be!~But~watch~your~syntax!G" } }{PARA 11 "" 1 "" {XPPMATH 20 "6#%foUse~'useproduct'~to~change~value~o f~_default_Clifford_product~in~Cl(B)~fromG" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%gocmulRS~when~B~is~symbolic~to~cmulNUM~when~B~is~numer ic.~Type~?cmul~for~help.G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%`oType~C LIFFORD_ENV()~to~see~current~values~of~environmental~variables.G" }} {PARA 11 "" 1 "" {XPPMATH 20 "6#%T++++++++++++This~is~CLIFFORD~version ~12++++++++++++G" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}}{MARK "22 0 0" 0 } {VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }