{VERSION 6 0 "IBM INTEL NT" "6.0" } {USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 1 0 0 0 0 1 }{CSTYLE "2D Math" -1 2 "Times" 0 1 0 0 0 0 0 0 2 0 0 0 0 0 0 1 }{CSTYLE "2D Output" 2 20 "" 0 1 0 0 255 1 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" 0 21 "" 0 1 0 0 0 1 0 0 0 0 2 0 0 0 0 1 }{CSTYLE "" -1 256 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 257 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 258 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 259 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 260 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 261 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 262 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 263 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 264 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 265 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 266 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 267 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 268 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 269 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 270 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 271 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 272 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 273 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 274 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 275 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 276 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 277 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 278 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 279 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 280 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 281 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 282 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 283 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 284 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 285 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 286 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 287 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 288 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 289 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 290 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 291 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 292 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 293 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 294 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 295 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 296 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 297 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 298 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 299 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 300 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 301 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 302 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 303 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 304 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 305 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 306 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 307 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 308 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 309 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 310 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 311 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 312 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 313 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 314 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 315 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 316 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 317 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 318 "Helvetica" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 319 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 320 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 321 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 322 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 323 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 324 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 325 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 326 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 327 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 328 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 329 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 330 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 331 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 332 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 333 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 334 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 335 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 336 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 337 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 338 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 339 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 340 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 341 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 342 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 343 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 344 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 345 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 346 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 347 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 348 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 349 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 350 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 351 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 352 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 353 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 354 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 355 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 356 "" 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 357 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 358 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 359 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 360 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 361 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 362 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 363 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 364 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 365 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 366 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 367 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 368 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 369 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 370 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 371 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 372 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 373 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 374 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 375 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 376 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 377 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 378 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 379 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 380 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 381 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 382 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 383 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 384 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 385 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 386 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 387 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 388 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 389 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 390 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 391 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 392 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 393 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 394 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 395 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 396 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 397 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 398 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 399 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 400 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 401 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 402 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 403 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 404 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 405 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 406 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 407 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 408 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 409 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 410 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 411 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 412 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 413 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 414 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 415 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 416 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 417 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 418 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 419 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 420 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 421 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 422 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 423 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 424 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 425 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 426 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 427 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 428 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 429 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 430 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 431 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 432 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 433 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 434 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 435 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 436 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 437 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 438 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 439 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 440 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 441 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 442 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 443 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 444 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 445 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 446 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 447 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 448 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 449 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 450 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 451 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 452 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 453 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 454 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 455 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 456 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 457 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 458 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 459 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 460 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 461 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 462 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 463 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 464 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 465 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 466 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 467 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 468 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 469 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 470 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 471 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 472 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 473 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 474 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 475 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 476 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 477 "" 1 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 478 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 479 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {PSTYLE "Normal" -1 0 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "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 "Maple Output" -1 11 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "" 11 12 1 {CSTYLE "" -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }1 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "R3 Font 0" -1 256 1 {CSTYLE "" -1 -1 "Helveti ca" 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_M10_0 8.mws\n" }}{PARA 258 "" 0 "" {TEXT -1 25 "(Created: July 22, 2006)\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "############################### ##############################################\n# \+ #\n#DISCLAIMER: \+ #\n# \+ \+ #\n#THERE IS NO WARRANTY FOR THE CLIFFORD, BIGEBRA, Cliplus, Octonio n, GTP #\n#PACKAGES TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXC EPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE #\n#PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, #\n#INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY #\n#AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY #\n#AND PERF ORMANCE 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 "This is a listing (without examples) o f all procedures in a Maple package called 'CLIFFORD' (Version 10, Co pyright 1995-2006 by Rafal Ablamowicz, Tennessee Technological Univer sity), and Bertfried Fauser, Universit\"at Konstanz, for Maple 108. U ser will know which version he/she is using by using the 'version()' f unction." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 277 55 "The following procedures can use index such as K or -K:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 66 "cmul[K](p1,p2,. ..,pn); ##Clifford product of p1,p2,...,pn in Cl(K)" }}{PARA 0 "" 0 " " {TEXT -1 81 "&c[K](p1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (ampersand form)" }}{PARA 0 "" 0 "" {TEXT -1 112 "cmulQ[K](p 1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (here K is e xpected to be a diagonal matrix)" }}{PARA 0 "" 0 "" {TEXT -1 126 "&cQ[ K](p1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (here K \+ is expected to be a diagonal matrix), ampersand form" }}{PARA 0 "" 0 " " {TEXT -1 56 "cexp[K](p,N); ## exponential of p in Cl(K) up to order \+ N" }}{PARA 0 "" 0 "" {TEXT -1 102 "cexpQ[K](p,N); ## exponential of p \+ in Cl(K) up to order N (here K is expected to be a diagonal matrix)" } }{PARA 0 "" 0 "" {TEXT -1 53 "climinpoly[K](p); ## minimal polynomial \+ of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 91 "sexp[K](p,N); ## exponen tial of p in Cl(K) up to order N modulo the minimal polynomial of p" } }{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 278 96 "The fol lowing procedures can use name K or a numeric multiple of a name as an optional argument:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 " " {TEXT -1 106 "LC(p1,p2,K); ##left contraction of p2 by p1 w.r.t. K\n RC(p1,p2,K); ##right contraction of p1 by p2 w.r.t. K" }}{PARA 0 "" 0 "" {TEXT -1 68 "cmulNUM(m1,m2,K); ##Clifford (numeric) product of m1 a nd m2 in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 41 "reversion(p,K); ##rever sion of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 43 "cinv(p,K); ##Cliffo rd inverse of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 73 "LCQ(p1,p2,K); ##left contraction of p2 by p1 w.r.t. diagonal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 74 "RCQ(p1,p2,K); ##right contraction of p1 by p2 w .r.t. diagonal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 46 "conjugatio n(p,K); ## conjugation of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 279 86 "The folllowing procedures can pass on \+ name or a numeric multiple of a name via a list:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 121 "type([p,K],nilpotent); # # checks if p is nilpotent in Cl(K)\ntype([p,K],idempotent); ## checks if p is idempotent in Cl(K)" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 580 "\nProcedures that define types: `type/ climon`, `type/clipolynom`, `type/climatrix` as well as other procedur es such as 'reorder', 'wedge', etc., have been substantially revised t o improve efficiency and speed of the package. This work has been done together with Bertfried Fauser, Universit\"at Konstanz, in Cookeville on October 5, 2001. \n\nThis version includes \"Bigebra\" package tha t has been created together with Bertfried Fauser, Universit\"at Konst anz, Konstanz, Germany. Additional help pages have been written and ad ded to the database that explain the usage of this package." }{TEXT 276 0 "" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 302 "An additional feature in this version is an ability to display and change environmental variables. They can be displayed with proced ure CLIFFORD_ENV.\n\nThis package is made to run under Maple 10. It i s available on a server of the Department of Mathematics, Tennessee \+ Technological University, at: \n" }}{PARA 258 "" 0 "" {TEXT -1 69 " \+ http://math.tntech.edu/rafal/clifford/ " } }{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 130 "In \+ order to create a Maple file 'Clifford.m' containing the 'CLIFFORD' pa ckage, execute this worksheet.\n\nTo load the package type:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">with(Cliff ord); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 189 "You will know if the package has been loaded because a list wi th Clifford procedures will be displayed on the screen. To check the \+ current version of the package, at the Maple prompt type " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 12 ">version( ) ;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 35 " Rafal Ablamowicz, Ph.D. and Chair " }}{PARA 258 "" 0 "" {TEXT -1 35 " Department of Mathematics, Box 5054" }}{PARA 258 "" 0 "" {TEXT -1 36 " Tennessee Technological University " }}{PARA 258 "" 0 "" {TEXT -1 21 "Cookeville, TN 38505 " }}{PARA 258 "" 0 "" {TEXT -1 24 "rablamowicz@t ntech.edu " }}{PARA 258 "" 0 "" {TEXT -1 25 "phone: USA (931) 372-356 9" }}{PARA 258 "" 0 "" {TEXT -1 23 "fax: USA (931) 372-6353" }}{PARA 0 "" 0 "" {TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 "restart :\nunprotect('Clifford','e','qi','qj','qk','Id','w');" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 989 "Clifford:=module()\n########################### ########\nexport `&m`, Bsignature, CLIFFORD_ENV, Kfield, LC, LCQ, RC, \+ RCQ, RHnumber, adfmatrix, all_sigs, beta_minus, beta_plus, buildm, byg rade, c_conjug, cbasis, cdfmatrix, cexp, cexpQ, cinv, clibilinear, cli collect, clidata, clilinear, climinpoly, cliparse, cliremove, clisolve , clisort, cliterms, cmul, cmulNUM, cmulQ, cmulRS, cmulgen, cocycle, c ommutingelements, conjugation,ddfmatrix, diagonalize, displayid, extra ct, factoridempotent, find1str, findbasis, gradeinv, init, isVahlenmat rix, isproduct, makealiases, makeclibasmon, matKrepr, maxgrade, maxind ex, mdfmatrix, minimalideal, ord, permsign, pseudodet, q_conjug, qdisp lay, qinv, qmul, qnorm, reorder, reversion, rmulm, rot3d, scalarpart, \+ sexp, specify_constants, spinorKbasis, spinorKrepr, squaremodf, subs_c lipolynom, useproduct, vectorpart, version, wedge, wexp, rd_clibasmon, rd_climon, rd_clipolynom;\n###################################\nlocal setup;\noption package, load=setup;\n" }}{PARA 258 "" 0 "" {TEXT -1 84 "No. 1. Name 'version' stores information about the current version of the package. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 25 "Typical use: version(); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1514 "version:= proc()\noptio ns `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\npr int(`+++++++++++++++++++++++++++++++++++++++++++`);\nprint(`CLIFFORD - A Maple 10 Package for Clifford Algebras with \"Bigebra\"`); \nprint( `(Version 10 with environmental variables given by CLIFFORD_ENV())`); \nprint(`Last revised: July 22, 2006 (Source file: clifford_M10_08.mws )`);\nprint(`Copyright 1995-2006 by Rafal Ablamowicz (*) and Bertfried Fauser ($)`);\nprint(``);\nprint(`(*) Department of Mathematics, Box \+ 5054`);\nprint(` Tennessee Technological University, Cookeville, TN 38505`);\nprint(` tel: USA (931) 372-3569, fax: USA (931) 372-6353 `);\nprint(` rablamowicz@tntech.edu`);\nprint(` http://math.tnte ch.edu/rafal/Cliff8/`);\nprint(`($) Universit\"at Konstanz, Fachbereic h Physik, Fach M678`);\nprint(` 78457 Konstanz, Germany`);\nprint(` Bertfried.Fauser@uni-konstanz.de`);\nprint(` http://kaluza.phys ik.uni-konstanz.de/~fauser/`); \nprint(``);\nprint(`If you are a \+ Clifford algebra pro, assign 'true' to '_prolevel' and see`);\nprint(` how much faster your computations will be! But watch your syntax!`);\n print(`Use 'useproduct' to change value of _default_Clifford_product i n Cl(B) from`);\nprint(`cmulRS when B is symbolic to cmulNUM when B is numeric. Type ?cmul for help.`);\nprint(`Type CLIFFORD_ENV() to see c urrent values of environmental variables.`); \nprint(`++++++++++++This is CLIFFORD version 10++++++++++++`);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 2. Procedure " }{TEXT 282 17 "specify_constants" } {TEXT -1 503 " allows user to specify any new symbolic constants, e.g. , a, b, c, B, e.t.c, which are to be known to Maple. The originally \+ known constants are stored in a global, non-protected variable 'consta nts' and must be saved separately, if needed. This procedure is neede d when sorting or collecting multivariate Clifford polynomials contain ing expressions like 'aa*eiwej' in which 'aa' is intended to be a cons tant and 'eiwej' is intended to be a Clifford basis monomial with indi ces i and j. Before using " }{TEXT 281 7 "clisort" }{TEXT -1 4 " or \+ " }{TEXT 280 10 "clicollect" }{TEXT -1 350 " user should make any addi tional constants of length 2 or more known to Maple as shown below. I f these constants of length 2 or more are not defined as Maple constan ts, then some procedures might yield error messages (although an attem pt has been made to avoid this problem). Constants of length one are a utomatically assumed to be Maple constants. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: specify_co nstants(a, b, B, aa); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 186 "NOTE: from now on, extra spaces have been ad ded for the Reader's convenience in the sequence of input variables as in the above example. These spaces are not needed or required by Mapl e." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 368 "specify_constants:=proc(a1::anything) global constants;\noptions \+ `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n##### ########################################\nconstants:=op(\{constants,ar gs\});\nprintf(\"Maple now knows the following constant(s): %q\\n\",co nstants);\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 en dowed with a bilinear form B. The dimension of V is specified by a Ma ple global variable 'dim' where 1 <= dim <= 9. This procedure can be \+ used with one or two arguments as, for example, in cbasis(4) or cbasis (4, 2). In the first case, it returns a list of all basis elements in the Clifford algebra Cl(4). In the second case, it returns a list of \+ basis elements in the 2-vector subspace of Cl(4). Below, 'Id' stands f or the algebra unit element and 'w' denotes wedge/exterior 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, 'ev en'). In fact, 'even' can be replaced with any name which evaluates t o a string. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1872 "cbasis:=proc(a 1::nonnegint,a2::\{string,symbol,nonnegint\})\nlocal i,k,X,XX,YY,L,Lev en,Lodd,bas,nxt,ind,start; global choose,e;\noptions `Copyright (c) 19 95-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `,remember;\ndescription `Last revised: July 22, 2006`;\n############# ################################\nif a1>9 then \n error \"first argu ment must be between 0 and 9 inclusive but received %1 instead\",a1 \n end if;\nif a1=0 and nargs=1 then return [Id] end if;\nif nargs=2 and \+ type(a2,\{string,symbol\}) then do\n L:=procname(a1):\n Leven:=[Id ]:Lodd:=[]:\n if nops(L) > 1 then\n for i from 2 to nops(L) do\n \+ if type(length(L[i]),odd) then Leven:=[op(Leven),L[i]] else\n \+ Lodd:=[op(Lodd),L[i]]\n end i f \n end do \n end if; \nif args[2]='even' then return Leven \n \+ elif args[2]='odd' then return Lodd\n else error \"second argument m ust be an integer or a string 'even' or 'odd' but received %1 instead \",args[2]\nend if\nend do \nend if;\nfor k from 0 to a1 do \n X[k] :=combinat[choose]([seq(i,i=1..a1)],k) \nend do;\nif not nargs = 1 and not nargs = 2 then \n error \"one or two arguments are needed as in put 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 \"se cond 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 t hen \n bas:=e||0 else bas:=e||ind \n end if;\nfor i from 2 to nops(XX[k]) do \n ind:=XX[k][i]:\n if ind=10 then nxt:=e||0 els e nxt:=e||ind end if:\n bas:=cat(bas,\"w\",nxt): \n end do;\n YY[k]:=bas;\nend do:\nYY:=convert(YY,list);\nprotect(op(YY)); #protect basis monomials\nreturn YY\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 4. Procedure " }{TEXT 284 8 "find1str" }{TEXT -1 327 " find s all locations of the first string of length one in the second string of length at least one. It returns a set of these positions. If the \+ first string is not found then it returns \{0\}. This procedure is pri marily for internal use in 'type/clibasmon' and 'cliparse'. \nTypical \+ use: find1str(e,e1we2we3); find1str(w,e1we2);" }{MPLTEXT 0 21 1 "\n" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 659 "find1str:=proc(a1::symbol,a2::sym bol) local ns,p,p1,ap,le2;\nglobal _prolevel;\noptions `Copyright (c) \+ 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`,remember;\ndescription `Last revised: July 22, 2006`;\n########### ##################################\nle2:=length(a2):\nif _prolevel=fal se then\nif length(a1) <> 1 or le2<1 then \n error \"first string mu st be of length 1 but received %1 instead\",a1 \nend if;\nend if;\np: =SearchText(a1,a2):\nap:=\{p\}:p1:=p:\nwhile p<>0 and p10 the n 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. Func tion " }{TEXT 285 8 "cliparse" }{TEXT -1 349 " checks user's input for correct spelling of basis monomials. When unable to decide if the gi ven input is correct, it tells the user to check spelling or define th e given string as a Maple constant. If the spelling is correct, it ret urns true; if it is not correct, it returns a set of suspect words.\n \+ \nTypical use: cliparse(e1+e2we3+2*Pi*B[1,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1176 "cliparse:=proc(a1::anything) local x,S1,S2,p,S;\ngl obal _prolevel,_scalartypes;\noptions `Copyright (c) 1995-2006 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n##################################### ########\nif _prolevel then return true end if;\nif type(a1,_scalartyp es) then return true end if;\np:=remove(type,a1,_scalartypes):S1:=\{op (p)\}:\nfor x in S1 do \n if type(x,_scalartypes) or type(x,clibasm on) then S1:=S1 minus \{x\} end if;\nend do; \nS2:=map(op,S1); \nfor x in S2 do \n if type(x,_scalartypes) or type(x,clibasmon) then S2:= S2 minus \{x\} end if;\nend do;\nS:=remove(hastype,map(op,\{op(expand( p))\}),\{op(_scalartypes),clibasmon\});\nfor x in S do \n if find1s tr(e,x)=\{0\} and x<>'Id' then S:=S minus \{x\} end if;\nend do;\nif S =\{\} then return true end if;\nS1:=select(type,S,procedure):\nif S1 < > \{\} then\n error \"procedure name %1 that has been found in input is not allowed as a symbolic coefficient\",op(S1)\nend if;\nif nops(S )=1 then \n error \"check spelling of %1 or 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. Function " }{TEXT 286 9 "displayid" } {TEXT -1 186 " replaces a user-entered Clifford scalar with the scalar times the unit element 'Id'. It may also be applied to matrices with \+ Clifford algebra entries.\n\nTypical use: displayid(e1+2*Pi);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 618 "displayid:=proc(a1::\{array,matrix ,algebraic\}) local KK,p;\noptions `Copyright (c) 1995-2006 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: July 22, 2006`;\n######################################## #####\nKK:=proc() if type(args[1],cliscalar) then return args[1]*Id \n elif hastype(args[1],clibasmon) then return args[1] \n \+ end if \nend proc:\nif type(a1,\{array,matrix\}) then return map (procname,a1) end if;\np:=expand(a1):\nif type(p,\{`*`,cliscalar,cliba smon,climon\}) then return KK(p) \nelif type(p,\{`+`\}) then return ma p(KK,p) \nelse return a1 \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 7. Procedure " }{TEXT 287 8 "cliterms" }{TEXT -1 222 " identifies Clifford basis elements in the given Clifford polynomial. \n\nNOTE: 'cliterms' also works with terms of type cliprod and it find s correctly terms involving such expressions. \n\nTypical use: cliterm s(2*Pi+2*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1016 "cliterms:= \+ proc(a1::anything) local S1,S2,S3,x,p,Cliplusflag;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: July 22, 2006`;\n############### ##############################\nCliplusflag:=assigned(Cliplus):\nif ha stype(a1,cliprod) and not Cliplusflag and _warnings_flag then \n WAR NING(`argument to 'cliterms' contains type cliprod. Load 'Cliplus' to \+ extend functionality of CLIFFORD. Type ?cliprod for help.`)\nend if; \nif type(a1,\{clibasmon,cliprod\}) then return \{a1\} end if;\np:=dis playid(simplify(a1)):\nif hastype(p,cliprod) then \n S1:=remove(type ,\{op(p)\},cliscalar);\n S2:=select(hastype,S1,\{clibasmon,climon,cl iprod\});\n S3:=\{\}:\n while not S2=\{\} do\n S3:=S3 unio n select(type,S2,\{clibasmon,cliprod\});\n S2:=select(hastype, map(op,remove(type,S2,\{clibasmon,cliprod\})),\{clibasmon,cliprod\}); \n end do;\nreturn S3\nend if;\nx:='x':\nS1:=remove(type,\{op(p)\},c liscalar);\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 th e third argument bilinear with respect to Clifford scalars in the firs t two arguments. The first two arguments are of the type clipolynom, i .e., Clifford polynomials. The third argument is a string or a procedu re.\nIt can handle terms involving elements of type cliprod.\n\nTypica l use: clibilinear(e1+2*e2we3,Id+2*e2+e3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 919 "clibilinear:=proc(a1,a2,a3::\{procedure,name,symbol, matrix,array\}) \n local tail,p1,p2,S1,S2,S12,res,x,y,cli1 ,cli2,co1,co2;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz a nd Bertfried Fauser. All rights reserved.`;\ndescription `Last revised : July 22, 2006`;\n#############################################\nif s implify(a1)=0 or simplify(a2)=0 then return 0 end if; \np1:=clicollect (a1):\np2:=clicollect(a2):\n tail:=args[4..-1];\n if type(p1,\{climo n,cliprod\}) then S1:=[p1] else S1:=[op(p1)] end if:\n if type(p2,\{c limon,cliprod\}) then S2:=[p2] else S2:=[op(p2)] end if:\n S12:=[seq( seq([x,y],x=S1),y=S2)];#this list will be huge for long polynomials\n \+ res:=0:\n for x in S12 do \n cli1:=select(type,x[1],\{cliprod,cli basmon\}):\n cli2:=select(type,x[2],\{cliprod,clibasmon\}):\n co 1:=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 procedure K specified as the second argument \+ linear with respect to Clifford scalars (elements of type cliscalar). \+ It can now distribute over Clifford polynomials with elements of `type /cliprod`. Any additional parameters are passed on to the procedure en tered as the second argument.\nTypical use: clilinear(a*e1+2*e2we3,K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 618 "clilinear:=proc(a1::\{symbol ,cliscalar,clibasmon,climon,clipolynom\},a2::\{name,procedure\}) \nloc al tail,p1,S1,res,x,cli1,co1;\noptions `Copyright (c) 1995-2006 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: July 22, 2006`;\n#################################### #########\ntail:=args[3..-1];\nif type(a1,cliscalar) then return a1*a2 (Id,tail) end if;\np1:=displayid(a1):\nif type(p1,climon) then S1:=[p1 ] else S1:=[op(p1)] end if:\nres:=0:\nfor x in S1 do\n cli1:=select (hastype,x,\{clibasmon,cliprod\}):\n co1:=coeff(x,cli1); \nres:=res +co1*a2(cli1,tail):\nend do:\nreturn res\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 10. Procedure " }{TEXT 290 7 "clisort" }{TEXT -1 312 " sorts the given multivariate Clifford polynomial with respect to the Clifford indetereminates found in the expression via the proce dure 'cliterms'. It puts scalar coefficients of the type cliscalar in \+ front of the Clifford basis monomials. It may also be applied to matri ces 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 436 "clisort:=proc(p::a lgebraic) local L,N;\noptions `Copyright (c) 1995-2006 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: July 22, 2006`;\n############################################# \nif type(p,matrix) then return map(procname,p) end if;\nif type(eval( p),\{climon,clipolynom\}) or hastype(eval(p),cliprod) then\n L:=clit erms(expand(displayid(p)));\n return sort(p,L);\nend if:\nreturn p\n end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 11. Procedure " } {TEXT 291 10 "clicollect" }{TEXT -1 382 " reorders monomial terms in s tandard order and then collects them in a multivariate Clifford polyno mial. It may also be applied to matrices with entries in a Clifford al gebra. It will simplify 6 + 7*Id to 13*Id. It collects now terms of t ype cliprod, if present.\n\nNOTE: 'clicollect' also works with terms o f type cliprod and it collects correctly terms involving such expressi ons. " }}{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 493 "clicollect:=proc(a1::algebraic) local p,L; \nopti ons `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n# ############################################\nif type(a1,matrix) then \+ return map(procname,a1) end if;\np:=expand(a1):\nif type(p,cliscalar) \+ then return p*Id\nelif type(p,clipolynom) then \n L:=cliterms(p); \n return map(simplify,collect(displayid(p),L,'distributed'))\nels e return args[1] \nend if\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 12. The procedure " }{TEXT 292 3 "ord" }{TEXT -1 319 " return s an ordered list of positions in a monomial, e.g., e1we2, where vect or indices are found. Then, nops(ord(e1we2)) can be used to find the order of the monomial. Note that for consistency we have ord(Id) = o rd(numeric) = ord(numeric*Id) = ord(cliscalar)=[] where cliscalar is a ny 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 383 "or d:=proc(a1) local v,k;\noptions `Copyright (c) 1995-2006 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n########################################### ##\nif type(a1,cliscalar) then return [] end if;\nv:=select(type,a1,cl ibasmon);\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 "No. 13. Procedure " }{TEXT 293 9 "cliremove" }{TEXT -1 193 " r emoves one symbol 'ei' from the location specified by the procedure 'o rd'. \n(NOTE: procedure 'ord' specifies location of the index 'i' in ' ei'.) This procedure is primarily for internal use." }}{PARA 0 "" 0 " " {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 575 "cliremove:=proc( p::posint,s::symbol) local S1,S2;global _prolevel;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`,remember;\ndescription `Last revised: July 22, 2006`;\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:= substring(s,1..(p-3));\nif length(S2)=0 and S1 <> s then return S1 \n \+ elif S1 = s then return S2 \n else return cat(S1,\"w\",S2); \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. Procedure \+ " }{TEXT 294 7 "extract" }{TEXT -1 445 " extracts indices of a monomia l (or a constant times a monomial) and it returns them as a list of st rings. If necessary, they can be returned as a list of integers if op tion 'integers' is selected (in fact, any name which evaluates to a st ring may be used as the option). Indices could be now integers, lette rs, or they could be mixed. Note that extract(Id) = [] and extract(num eric) = 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 728 "extract: =proc(a1,a2) \nlocal v,k,inds;global _prolevel,str_to_int;\noptions `C opyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`,remember;\ndescription `Last revised: July 22, 2006`; \n#############################################\nif type(a1,cliscalar) or (type(a1,symbol) and length(a1)=1) then return [] \nelif\n type( a1,\{climon,clibasmon\}) then v:=select(type,a1,clibasmon):\nelse \n \+ error \"wrong argument: %1\",a1 \nend if;\nif v = Id then return [] e nd if;\ninds:=map(convert,remove(member,StringTools:-Explode(v),\{\"e \",\"w\"\}),symbol);\nif nargs=1 then return inds \n elif type(a2,sy mbol) then \n return map(parse,inds)\n else error \"wrong op tion 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 polynomial \+ using standard ordering and calculates sign of each permutation, e.g., reorder(e1we3we2) = -e1we2we3, reorder(e2we1 + 2*e1we5we2) = -e1we2 - 2*e1we2we5. If any one of the indices of the monomial is a letter, e. g., reorder(eiwe3) = eiwe3, reorder returns its argument. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 139 "Reorder no w 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 "Typical use : reorder(e2we1 + 2*Id + e4we3we1); " }}{PARA 0 "" 0 "" {TEXT -1 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1072 "reorder:=proc(a1::algebraic) \+ \n local L1,L2,N,newbas,f,a,x,K,dummy_set,n12,s12,ss;\n \+ global B,dim_V;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: July 22, 2006`;\n#############################################\ni f type(a1,\{matrix,`+`,`*`\}) then return map(procname,a1) end if; \nL 1:=Clifford:-extract(a1);\nN:=nops(L1);\nif N>9 then error \"detected \+ basis monomial of grade higher than 9 in the input\" end if;\nif N=0 o r 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 while f(x)< >a do\n x:=f(x);\n dummy_set:=dummy_set minus \{x\};\n \+ K:=K+1;\n end do:\nend do:\nnewbas:=cat(e||(op(L2[1..-2]))||w,e,L2[-1 ]):\nreturn (-1)^K*newbas\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 35 "No. 16. Defining a useful function " }{TEXT 296 8 "maxindex" } {TEXT -1 226 " which finds the greatest index in the given Clifford po lynomial or in the given list or set of Clifford monomials. It returns 0 for a Clifford scalar (an element of type cliscalar).\n\nTypical us e: maxindex(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 809 "maxindex:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom,list,s et\}) \nlocal inds,mons,symbinds;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescri ption `Last revised: July 22, 2006`;\n################################ #############\nif type(a1,cliscalar) or a1=Id then return 0 elif\n t ype(a1,list) then return max(op(convert(map(procname,a1),set))) elif\n type(a1,set) then return max(op(map(procname,a1))) else \n mons:= cliterms(a1);\n inds:=map(op,map(Clifford:-extract,mons,'integers')) ;\n symbinds:=remove(type,inds,integer);\n if 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 co ntains symbolic index or indices\"\n end if;\n end if;\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 35 "No. 17. Defining a useful function \+ " }{TEXT 297 8 "maxgrade" }{TEXT -1 176 " which finds the maximum grad e in the given Clifford polynomial. It returns 0 for a Clifford scala r (an element of type cliscalar).\n\nTypical use: maxgrade(a*Id+6+2*Pi *e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 396 "maxgrade:=proc(a1:: \{cliscalar,clibasmon,climon,clipolynom\}) local S;\noptions `Copyrigh t (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: July 22, 2006`;\n############## ###############################\nif type(eval(a1),cliscalar) then retu rn 0 end if;\nS:=\{op(cliterms(eval(a1)))\}:\nreturn max(op(map(nops,m ap(Clifford:-extract,S))))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 18. Procedure " }{TEXT 298 2 "LC" }{TEXT -1 233 " defines a l eft contraction between any multivector u and a multivector v, i.e., m ultivector u acts on the multivector v from the left. This procedure \+ is now bilinear in both arguments. It can accept third argument such \+ as K or -K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: LC(e1 + 2*e2, e1we3 + b*e2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2313 "LC:=proc(x1::\{cliscalar,clibasmon,clim on,clipolynom\},\n y1::\{cliscalar,clibasmon,climon,clipolynom \})\n local N1,N2,lst1,lst2,i,j,cf,term,lname,res,coB,nameB,x,y;\n \+ global _CLIENV,B;\noptions `Copyright (c) 1995-2006 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: July 22, 2006`;\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 LC. See ?LC for m ore help.\" \n end if;\nelse\n error \"two or three arguments exp ected in LC. See ?LC for more help.\"\n end if;\n##################### ###########\nx,y:=expand(x1),expand(y1): ##NEW\n if type(x,clibasmon) then\n if type(y,clibasmon) then\n lst1:=Clifford:-extract(x, 'integers');\n lst2:=Clifford:-extract(y,'integers');\n N1:= nops(lst1);N2:=nops(lst2);\n if N1>N2 then return 0 end if;\n \+ if N1=0 then return y end if;\n if N1=1 then \n res:=`+ `(seq(coB*nameB[lst1[1],lst2[j]]*_CLIENV[_QDEF_PREFACTOR]^(j-1)*\n \+ makeclibasmon([op(subs(lst2[j]=NULL,lst2))]),j=1 ..N2));\n return reorder(res) \n else\n res:=\nprocn ame(makeclibasmon(lst1[1..-2]),procname(makeclibasmon([lst1[-1]]),y,ln ame),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,cl ipolynom) then\n return add(procname(x,i,lname),i=[op(y)])\n \+ elif type(y,cliscalar) then \n return displayid(scalarpart (x)*y)\n end if; \n elif type(x,climon) then\n term,cf:=selec tremove(type,x,clibasmon);\n return expand(cf*procname(term,y,lname ))\n elif type(x,clipolynom) then\n return add(procname(i,y,lname) ,i=[op(x)])\n elif type(x,cliscalar) then \n return x*reorder(y)\n end if;\nerror \"Got input %1 and %2 but LC can only process consta nts 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 orthogona l Clifford algebra Cl(Q) of the quadratic form Q defined via the symme tric part g of B as Q(x) = g(x, x) = B(x, x). It can accept name as a third optional argument or a numeric multiple of a name." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 76 "Proposed by Yvon Siret, Universite Joseph Fourier, Grenoble, France. Thanks!" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 82 "Typic al use: LCQ(e1 + 2*e2, e1we3 + b*e2we3);\nLCQ(e1 + 2*e2, e1we3 + b*e2w e3,K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1791 "LCQ:=proc(x::\{clisc alar,clibasmon,climon,clipolynom\},\n y::\{cliscalar,clibasmo n,climon,clipolynom\}) \n local ii,N,L,m,Sxy,symbxy,lname,coB,name B;global B:\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: J uly 22, 2006`;\n#############################################\nif narg s=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 typ e(args[3],`&*`(numeric,\{name,symbol,matrix,array\})) then\n coB :=op(select(type,\{op(args[3])\},numeric));\n nameB:=op(remove(t ype,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \n \+ error \"wrong type of third argument in LCQ. See ?LCQ for more hel p.\" \n end if;\nelse\n error \"two or three arguments expected i n 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'));\nsymbxy:=remove(type,Sxy,po sint);\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 ty pe(evalm(lname),matrix) then \n N:=linalg[coldim](evalm(lname)):\n \+ if m>N then \n error \"input contains index larger than size of \+ bilinear form %1\",lname \n end if;\nend if:\nif type(lname,\{name,s ymbol,array,matrix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n retur n LC(x,y,linalg[diag](L))\nelif \n type(lname,`&*`(numeric,\{name,sy mbol,array,matrix\})) then\n coB:=op(select(type,\{op(lname)\},numer ic));\n nameB:=op(select(type,\{op(lname)\},\{name,symbol,array,matr ix\}));\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 c ontraction between any multivector u and a multivector v, i.e., multiv ector u acts on the multivector v from the right. This procedure is n ow bilinear in both arguments. It can accept third optional argument \+ like B or -B." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 258 46 "Typical use: RC(e1 + 2*e2, e1we3 + b*e2we3); \n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 2276 "RC:=proc(x::\{cliscalar,clibasmon ,climon,clipolynom\},\n y::\{cliscalar,clibasmon,climon,clipol ynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,lname,res,coB,nameB;\n g lobal _CLIENV,B;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revis ed: July 22, 2006`;\n#############################################\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \nelif n args=3 then\n if type(args[3],\{name,symbol,matrix,array\}) then\n \+ coB:=1:\n nameB:=args[3];\n lname:=args[3];\n eli f type(args[3],`&*`(numeric,\{name,symbol,matrix,array\})) then\n \+ coB:=op(select(type,\{op(args[3])\},numeric));\n nameB:=op(rem ove(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \+ \n error \"wrong type of third argument in RC. See ?RC for more \+ help.\" \n end if;\nelse\n error \"two or three arguments expecte d in RC. See ?RC for more help.\"\nend if;\n########################## ######\n if type(x,clibasmon) then\n if type(y,clibasmon) then\n \+ lst1:=Clifford:-extract(x,'integers');\n lst2:=Clifford:-extr act(y,'integers');\n N1:=nops(lst1);N2:=nops(lst2);\n if N2> N1 then return 0 end if;\n if N2=0 then return x end if;\n i f N2=1 then \n res:=`+`(seq(coB*nameB[lst1[-i],lst2[1]]*_CLIEN V[_QDEF_PREFACTOR]^(i-1)*\n makeclibasmon([op(subs( lst1[-i]=NULL,lst1))]),i=1..N1));\n return reorder(res) \n \+ else\n res:=procname(procname(x,makeclibasmon([lst2[1]]), lname),\n makeclibasmon(lst2[2..-1]), lname);\n return reorder(res)\n end if;\n elif type(y, climon) then\n term,cf:=selectremove(type,y,clibasmon);\n re turn expand(cf*procname(x,term,lname))\n elif type(y,clipolynom) th en\n return add(procname(x,i,lname),i=[op(y)])\n elif type(y,c liscalar) then return reorder(x)*y \n end if;\n elif type(x,climo n) then\n term,cf:=selectremove(type,x,clibasmon);\n return expa nd(cf*procname(term,y,lname))\n elif type(x,clipolynom) then\n ret urn 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 Clifford numbers\",x,y\n end 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 1796 "RCQ:=proc(x::\{cliscalar,clibasmo n,climon,clipolynom\},\n y::\{cliscalar,clibasmon,climon,clip olynom\}) \n local ii,N,L,m,Sxy,symbxy,lname,coB,nameB;global B:\n options `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: July 22, 2006` ;\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 nameB:=op(remove(type,\{op(ar gs[3])\},numeric));\n lname:=args[3]:\n else \n error \+ \"wrong type of third argument in RCQ. See ?RCQ for more help.\" \n \+ end if;\nelse\n error \"two or three arguments expected in RCQ. See ?RCQ for more help.\"\nend if;\n################################\nSxy :=remove(type,map(op,\{op(x),op(y)\}),cliscalar);\nSxy:=map(op,map(Cli fford:-extract,Sxy,'integers'));\nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n return RC(x,y,lname) \nend if;\nm:=max(op(Sx y),1);# 1 is needed when both x and y have maxindex=0\nif type(evalm(l name),matrix) then \n N:=linalg[coldim](evalm(lname)):\n if m>N th en \n error \"input contains index larger than size of biline ar form %1\",lname \n end if:\nend if:\nif type(lname,\{name,symbol, array,matrix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n return RC(x ,y,linalg[diag](L))\nelif \n type(lname,`&*`(numeric,\{name,symbol,a rray,matrix\})) then\n coB:=op(select(type,\{op(lname)\},numeric)); \n nameB:=op(select(type,\{op(lname)\},\{name,symbol,array,matrix\}) );\n L:=seq(coB*nameB[ii,ii],ii=1..m);\n return RC(x,y,linalg[diag ](L))\n end if;\nend proc:" }}{PARA 258 "" 0 "" {TEXT -1 19 "\nNo. 22. Procedure " }{TEXT 303 8 "gradeinv" }{TEXT -1 133 " is the grade invo lution in the Clifford algebra,i.e., it reverses signs of odd elements and leaves signs of even elements unchanged." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typical use: gradeinv(e 1 + e1we2 - 4*e3we4); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 549 "grad einv:=proc(a1::\{matrix,cliscalar,clibasmon,climon,clipolynom\}) globa l _CLIENV;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: Ju ly 22, 2006`;\n#############################################\nif type( a1,matrix) then return map(procname,a1) end if;\n#if not assigned(_CLI ENV) then _CLIENV[_QDEF_PREFACTOR]:=-1 end if;\nif type(a1,clibasmon) then return (_CLIENV[_QDEF_PREFACTOR])^maxgrade(a1)*a1 \n \+ else return clilinear(a1,procname) \nend if;\nend proc:\n" } }{PARA 258 "" 0 "" {TEXT -1 19 "No. 23. Define the " }{TEXT 304 5 "wed ge" }{TEXT -1 1306 " product of any number of Clifford polynomials. T he infix form of this associative multiplication is `&w`. Thus, e1 &w e2 = wedge(e1, e2), etc. Via the procedure 'rmulm' described below, \+ wedge multiplication may be applied to matrices with entries in a Clif ford algebra or in an exterior algebra.\n\nNew feature: When the dimen sion of the vector space is known, either from the size of the matrix \+ B or from the global parameter dim_V that can be set by the user, the \+ output of the procedure does not include terms of grade higher than th e dimension of the vector space in case symbolic indices are used. \n \nThe default value of this global variable is 9 and it it set by the \+ initialization file when Clifford is loaded.\n\nWhen the procedure is \+ invoked, it checks whether the bilinear form B has been defined. If ye s, the procedure checks whether the size of B is less than the current value of dim_V. If again yes, a warning message is issued by the proc edure and the value of dim_V is reduced. If the size of B is larger th an the current value of dim_V, no warning message is issued and the va lue of dim_V is increased to linalg[coldim](B).\n\nThe warning messag e can be supressed by addign 'false' to a global parameter _warnings_f lag whose default value is set to true by the Clifford initialization \+ file." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 96 "Typical use: wedge(e1 + e2, e4 + e1we2); wedge(e2 + 2*e1, e3, e4) ; (e2 + 2*e1) &w (e3 + 2*); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3058 "wedge:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ a2::\{cliscalar,clibasmon,climon,clipolynom\}) \nlocal ii,kk,w edge2,pi,p1,p2,i1,i2,i12,n12,maxindexflag,expr,maxin;\nglobal dim_V,B, _warnings_flag;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: July 22, 2006`;\n#############################################\nkk: ='kk':\nif member(0,[args]) then return 0 \nelif \n remove(type,\{ar gs\},cliscalar)=\{\} then return product(args[kk],kk=1..nargs)\nend if ;\nif type(B,matrix) then\n if linalg[coldim](B)<>dim_V then \n \+ if linalg[coldim](B) < dim_V then\n dim_V:=linalg[coldim](B); \n if _warnings_flag then\nprintf(\"Warning, since B has been \+ (re-)assigned, value of dim_V has been reduced by 'wedge' to %g\\n\",d im_V);\n end if;\n elif linalg[coldim](B)>dim_V then\n \+ dim_V:=linalg[coldim](B);\n end if;\n end if;\n end if; \nif n ot type(dim_V,Range(0,10)) or \n not type(dim_V,posint) then\n err or \"value of dim_V must be a positive integer between 1 and 9, inclus ive, but current value of dim_V is %1\",dim_V\nend if;\n############## ##\ni12:=\{\}:\nfor ii from 1 to nargs do\n pi:=args[ii]: \n i12 :=i12 union map(op,map(Clifford:-extract,cliterms(pi),'integers')):\ne nd do;\nn12:= select(member,i12,\{1,2,3,4,5,6,7,8,9\}):\nif not n12=\{ \} then\n maxin:=max(op(n12)); \n maxindexflag:=evalb(maxin > dim_ V);\nelse maxindexflag:=false:\nend if:\nif maxindexflag then \n err or \"argument(s) contain(s) index larger then current value of dim_V w hich is now %1. To complete computation, increase value of dim_V or as sign square matrix of size at least %2 by %3 to bilinear form B\",dim_ V,maxin,maxin\nend if;\n################\nwedge2:=proc() local expr,i1 ,i2,n1,n2,i12,s12,symbindexflag;global dim_V;\n i1:=\{op(Clifford:-ext ract(args[1]))\};n1:=nops(i1):\n i2:=\{op(Clifford:-extract(args[2])) \};n2:=nops(i2):\n if args[1]=Id then \n if n2>dim_V then return 0 \+ else return args[2] end if;\n end if;\n if args[2]=Id then \n if n1 >dim_V then return 0 else return args[1] end if;\n end if;\n i1:=\{o p(Clifford:-extract(args[1]))\};\n i2:=\{op(Clifford:-extract(args[2 ]))\};\n i12:=i1 union i2;\n s12:= remove(member,i12,\{`1`,`2`,`3` ,`4`,`5`,`6`,`7`,`8`,`9`\}):\n symbindexflag:=evalb(not s12=\{\}):\n if i1 intersect i2 <> \{\} then return 0 end if;\n if symbindexfl ag and nops(i1)+nops(i2) > dim_V then return 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,wed ge2);\n if hastype(expr,trig) then \n \+ return clicollect(map(combine,clicollect(expr),trig))\n \+ else \n return reorder(expr)\n \+ end if;\nelse expr:=procname(procname(a1,a2),args[3..nargs]):\n \+ if hastype(expr,trig) then \n return clicollect(map(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 "permsign" }{TEXT 306 118 " computes sign of a permutation that sorts a list of indices.\n\nTypical use: permsi gn([1,3,2]); permsign([j,1,i,k,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 877 "permsign:=proc(L::list) local newbas,ss,a,n12,s12,L1,L2,N,f,dum my_set,K,x;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: J uly 22, 2006`;\n#############################################\nL1:=L: \nN:=nops(L1):\nif N=1 then return 1 end if:\n################## new\n n12,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:=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:\nwhi le dummy_set <> \{\} do\n a:=dummy_set[1]:\n dummy_set:=dummy_set[2. .-1];\n x:=a:\n while f(x)<>a do\n x:=f(x);\n dummy_set:=d ummy_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 b etween any two Clifford monomials using the recursivelyChevalley's def inition of the Clifford product: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 93 " \+ xu = wedge(x, u) + LC(x, u) = x &w u + LC(x, u) \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 477 " where x is a vector and u is any element in the algebra, wedge(x,u) = \+ x &w u denotes the wedge or exterior product between x and u, and LC( x, u) denotes the left contraction of u by x. This procedure is now bi linear in both arguments. The infix form is available e.g., e1 &c e2. This procedure works in Clifford algebras in dimensions up to and in cluding 9. Multiplication of matrices with entries in a Clifford alge bra can be done with a procedure 'rmulm' described below." }}{PARA 0 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 128 "This procedure \+ requires third argument of type name or a numeric multiple of a name. \+ Then it computes Clifford product in Cl(K)." }}{PARA 258 "" 0 "" {TEXT -1 221 "\nThis version can take index as a way of passing a para meter. The index could be of type `&*`(numeric,\{name,symbol,array,ma trix\}) or of type \{name,symbol,array,matrix\}.\n\nWhen the bilinear form B is symbolic, use cmulRS." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 0 "" 0 "" {TEXT 264 55 "Typical use: cmulNUM(e1,e3we4,B); cmulNU M(e1,e3we4,-K);" }{TEXT 265 3 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2250 "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-2006 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n des cription `Last revised: July 22, 2006`;\n############################# ################\n###This is additional code for Maple 6 version:\n### ##########################################\nif hastype(\{a1,a2\},clipr od) then\n a12:=map(Cliplus:-clieval,[a1,a2]);\n return Cliplus:-c liexpand(clibilinear(a12[1],a12[2],procname,lname))\nend if: \n####### ###################################################################### #########\n### old name cmul2B: this procedure computes recursively Cl ifford product of any two #\n### cliscalars, clibasmons, climons, and \+ clipolynoms in Clifford algebras Cl(lname) #\n####################### ###############################################################\n if \+ nargs<>3 then error \"exactly three arguments are needed\" end if:\n \+ if has(0,map(simplify,[a1,a2])) then return 0 end if;\n if a2=`Id` th en return a1 end if:\n if a1=`Id` then return a2 end if:\n L:=Cliffo rd:-extract(a1,'integers');\n N:=nops(L):\n ################\n #### # The following will allow for lname to be -B, for example:\n if type (lname,\{name,symbol,array,matrix\}) then\n coB,nameB:=1,lname:\n \+ elif type(lname,`&*`(numeric,\{name,symbol,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 if;\n ################\n if N=0 then return coeff(a1,Id)*a2\n elif N=1 then\n L2:=Clifford:-extract(a2,'integ ers'):\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,L 2)),i=1..nops(L2))))\n elif N=2 then\n x1:=substring(a1,1..2):x2:= substring(a1,4..5);\n p2:=procname(x2,a2,lname):\n S:=clibilinea r(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))\n end 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 technique. It can accept now -K in place of the name.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4899 "cmulRS:=proc(a1,a 2,lname)\nlocal max_grade,L1,N1,L2,N2,genPS,fun1,fun2,srt,cup,pList1,P N1,\n pList2,PN2,pSgn1,pSgn2,a,i,j,m,n,res,pos1,pos2,F1,F2,coB,na meB,a12;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Ber tfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\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### This proc edure computes Clifford product of any two cliscalars, clibasmons, cli mons, #\n### and clipolynoms 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\" e nd if:\n if has(0,map(simplify,[a1,a2])) then return 0 end if;\n if \+ a1 = `Id` then return a2 end if;\n if a2 = `Id` then return a1 end if ;\n ################\n ##### The following will allow for lname to b e -B, for example:\n if type(lname,\{name,symbol,array,matrix\}) then \n coB,nameB:=1,lname:\n elif type(lname,`&*`(numeric,\{name,symb ol,array,matrix\})) then\n coB:=op(select(type,\{op(lname)\},numer ic));\n nameB:=op(select(type,\{op(lname)\},name));\n else\n \+ error \"third argument is of unexpected type\"\n end if;\n ######### #######\n L1:=Clifford:-extract(a1,'integers');\n N1:=nops(L1);\n L 2:=Clifford:-extract(a2,'integers');\n N2:=nops(L2);\n if N1=1 then \+ \n return reorder(simplify(makeclibasmon([L1[1],op(L2)])\n +add( (-1)^(i-1)*coB*nameB[L1[1],L2[i]]*makeclibasmon(subs(L2[i]=NULL,L2)),i =1..N2)))\n end if;\n if N2=1 then \n return reorder(simplify(mak eclibasmon([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#### genP S ; generate a power set of 1..N, option remember\n genPS:=proc(N)\n \+ local a,i,plst;\n option remember; \n a:=[seq(i,i=1..N)]:\n \+ plst:=[a]:\n for i in a do\n plst:=[op(subs(i=NULL,plst)),op (plst)]:\n end do:\n end proc:\n#### prepare combinatorics for L1: \n fun1:=proc(a1) a1 end proc:\n for i from 1 to N1 do\n fun1(i): =L1[i];\n end do:\n#### here is the old code for the poweset \n# a:= [seq(i,i=1..N1)]:\n# pList1:=[a]:\n# for i in a do\n# pList1 := [ op(subs(i = NULL,pList1)), op(pList1)]:\n# end do:\n####\npList1:=gen PS(N1); \n PN1:=nops(pList1)+1; ## added 1 here\n pList1:=sort(pLi st1,(a,b)->evalb(nops(a)<=nops(b)));\n pSgn1 :=[seq((-1)^(add(pList1[ i][m]-m,m=1..nops(pList1[i]))),i=1..PN1-1)];\n#### prepare combinatori cs for L2:\n fun2:=proc(a2) a2 end proc:\n for i from 1 to N2 do\n \+ fun2(i):=L2[i];\n end do:\n#### here is the old code for the powese t \n# a:=[seq(i,i=1..N2)]:\n# pList2:=[a]:\n# for i in a do\n# p List2 := [op(subs(i = NULL,pList2)), op(pList2)]:\n# end do:\n####\np List2:=genPS(N2);\n PN2:=nops(pList2)+1; ## added 1 here\n pList2:= sort(pList2,(a,b)->evalb(nops(a)<=nops(b)));\n pSgn2:=[seq((-1)^(add( pList2[i][m]-m,m=1..nops(pList2[i]))),i=1..PN2-1)];\n#### cup tangle o f the rota-stein sausage tangle\n cup:=proc(lst1,lst2,coB,nameB)\n \+ local i;\n if nops(lst1)<>nops(lst2) then return 0 end if;\n if lst1=[] then return 1 end if;\n if nops(lst1)=1 then return coB*na meB[lst1[1],lst2[1]] end if;\n add((-1)^(i-1)*coB*nameB[lst1[-1],ls t2[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 ter ms which are potentially non zero in the cup(..) tangle #\n########### ###################################################################### ##\n max_grade:=nops(\{op(L1),op(L2)\}); ## <== new code\n res:=0: \n pos1:=0:\n for j from 0 to N1 do # for all j-vectors of pList1\n F1:=N1!/((N1-j)!*j!);\n pos2:=0:\n for i from 0 to min(N2,max_grad e-j) do # for all i-vectors of pList2\n \+ # which do not exceed max_grade (others are zero)\n F2:=N 2!/((N2-i)!*i!);\n for n from 1 to F1 do\n for m from 1 to F2 do \n res:=res+\n pSgn1[pos1+n]*pSgn2[pos2+m]*\n cup( map(fun1,pList1[PN1-pos1-n]),map(fun2,pList2[pos2+m]),coB,nameB)*\n \+ makeclibasmon([op(map(fun1,pList1[pos1+n])),op(map(fun2,pList2[P N2-pos2-m]))])\n end do:\n end do:\n pos2:=pos2+F2;\n e nd do:\n pos1:=pos1+F1;\n end do: \nreturn reorder(res); ## note t hat cmulRS INCLUDES already reorder !!\nend proc:\n" }}{PARA 0 "" 0 " " {TEXT 267 19 "No. 28. Procedure " }{TEXT 312 7 "cmulgen" }{TEXT 313 47 " is just a place holder for a Clifford product." }{TEXT -1 1 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 554 "cmulgen:=proc() global _defa ult_Clifford_product,_warnings_flag;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndes cription `Last revised: July 22, 2006`;\n############################# ################\nif _default_Clifford_product <> 'cmulgen' then\n r eturn _default_Clifford_product(args)\nelse \n if _warnings_flag the n\n WARNING(\"to assign Clifford product, execute 'useproduct' with \+ argument cmulRS, cmulNUM, or cmul_user_defined first\");\n end if; \n return 'cmulgen'(args);\n end if; \nend proc:\n" }}{PARA 0 "" 0 " " {TEXT 268 25 "No. 29. Wrapper function " }{TEXT 314 4 "cmul" }{TEXT 315 90 " for the Clifford product given by cmulNUM, cmulRS, or other p rocedure such as 'cmulgen'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1375 " cmul:=proc() local lname;\noptions `Copyright (c) 1995-2006 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: July 22, 2006`;\n######################################## #####\n if type(op(procname),procedure) then\n lname:=`B`;\n else \n lname:=op(procname);\n end if;\n if member(0,[args]) then ret urn 0 end if;\n if nargs <=1 then return args end if;\n if nargs = 2 then\n##########################################################\n### Speed-wise it makes no difference whether cmulgen or #\n### _default_ Clifford_product is used in the following. # ######################## ##################################\n return clicollect(clibilinear(ev al(args[1]),eval(args[2]),cmulgen,lname)); \n end if;\n###### <=== do NOT use 'procname' in the next line this will not work\n############# #############################################\n### Speed-wise it makes no difference whether cmulgen or #\n### _default_Clifford_product is \+ used in the following. # ############################################ ##############\nif not type(_default_Clifford_product,procedure) then \+ \n error \"global variable _default_Clifford_product must be assigne d a procedure so that 'cmul' could proceed beyond this point. Sorry. F or help see ?cmul.\" \nend if;\n return procname(clibilinear(eval( args[1]),eval(args[2]),cmulgen,lname),args[3..-1]); \nend proc :\n" }}{PARA 0 "" 0 "" {TEXT 270 29 "No. 30: Ampersand version of " } {TEXT 316 4 "cmul" }{TEXT 317 226 ". This version of `&c` correctly us es -K for index. When K has been assigned a matrix, use\n&c[''K''](e1, e2) and &c[''-K''](e1,e2). Otherwise, use &c[K](e1,e2), &c[-K](e1,e2), or &c(e1,e2). (Has been moved to Clifford:-setup).\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2301 "`&m`:=proc() local NP,ARGS,coB,nameB,lname,dec index,flagdec;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz a nd Bertfried Fauser. All rights reserved.`;\ndescription `Last revised : July 22, 2006`;\n#############################################\n#### ###################################\n### Works when &c[''K''] or &c['' -K''] is entered and K is a matrix\n################################## #####\nflagdec:=true:\nif type(op(procname),procedure) then\n if typ e([args],listlist) then\n if type(op(args),array) then\n \+ WARNING(\"enclose index in double quotes as in &c[''B''] or &c[''-B''] when B has been assigned a matrix to avoid the following:\");\n \+ return 'procname(args)';\n end if;\n else coB:=1:\n name B:=`B`:\n lname:=`B`:\n ARGS:=[args]:\n flagdec:=fal se:\n end if;\nelse lname:=op(procname);\n ARGS:=[args];\n i f type(lname,`&*`(numeric,name)) then\n coB:=op(select(type,\{ op(lname)\},numeric));\n nameB:=op(select(type,\{op(lname)\},n ame));\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([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, 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 er ror \"cannot determine arguments and/or index from arguments\"\n end i f;\nreturn coB,nameB,[ARGS];\nend proc:\n############################# ########\nif flagdec then \n coB,nameB,ARGS:=decindex(args);\n lna me:=coB*nameB;\nend if;\nNP:=nops(ARGS);\nif member(0,ARGS) then retur n 0 end if;\nif NP <=1 then return op(ARGS) end if;\nreturn cmul[eval( lname)](op(ARGS)); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 271 18 "No. \+ 31. Procedure " }{TEXT 318 10 "useproduct" }{TEXT 319 80 " that allows user to select which procedure is used to compute Clifford product." }{TEXT 478 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1254 "useproduct:=p roc(name::\{symbol,name\})\nlocal wstr;\nglobal _default_Clifford_prod uct; #,cmulgen;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: July 22, 2006`;\n#############################################\n### ################################################################\n###T his procedure uses global variable _default_Clifford_product #\n##### ############################################################## \nif no t member(name,\{cmulRS,cmulNUM,cmulgen,cmul_user_defined\}) then \n \+ WARNING(\"expecting one of the following Clifford products: cmulRS, c mulNUM, cmulgen, or cmul_user_defined\") \nend if;\nif member(name,\{c mul_user_defined\}) and not type(name,procedure) then\n WARNING(\"no computations with cmul can be peformed yet since cmul_user_defined ha s not been defined as procedure. Select cmulRS, cmulNUM, or a new proc edure as argument to useproduct.\");\n _default_Clifford_product:=na me;\nreturn NULL;\nend if;\n################################\n_default _Clifford_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(w str);\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 gives the Clifford multiplication in the Clifford algebra of the qu adratic 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 'cmu l', it works now in all dimensions 1 through 9. Via the procedure 'rm ulm' described below in (32), this multiplication can also be applied \+ to matrices with entries in a Clifford algebra.\n\nThis procedure can \+ now accept an optional index which could be K or -K. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 78 "Proposed by Yvon S iret, Universite Joseph Fourier , Grenoble, France. Thanks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 158 "Typical us e: cmulQ(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*Id); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1420 "cmulQ:=proc() local ii,N,L,m,Sxy,symbxy,lname,coB,n ameB;global B:\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz a nd Bertfried Fauser. All rights reserved.`;\ndescription `Last revised : July 22, 2006`;\n#############################################\n#### ################################\nif type(op(procname),procedure) then \n lname:=`B`;\nelse\n lname:=op(procname);\nend if;\n########## ##########################\nif member(0,[args]) then return 0 end if; \n####################################\nSxy:=map(op,map(cliterms,\{arg s\}));\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers'));\nsymbxy:=r emove(type,Sxy,posint);\nif symbxy <> \{\} then \n return cmul[lname ](args) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when both x and y h ave maxindex=0\nif type(evalm(lname),matrix) then \n N:=linalg[coldi m](evalm(lname)):\n if m>N then \n error \"input contains index larger than size of bilinear form %1\",lname \n end if:\nend if:\n# ###############################\nif type(lname,\{name,symbol,array,mat rix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n return cmul[linalg[d iag](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:=seq(coB*nameB[ii,ii],ii=1..m);\n return cmul[linalg[diag](L)](a rgs); \nelse\n error \"index of unexpected type has been found in c mulQ\"\nend if;\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 272 29 "No. 33. \+ Ampersand version of " }{TEXT 322 5 "cmulQ" }{TEXT 323 222 ". This ver sion can accept index B and -B. When B has been defined as matrix, use \n&cQ[''B''](e1,e2) and &cQ[''-B''](e1,e2) . Otherwise, use &cQ[B](e1, e2), &cQ[-B](e1,e2) or &cQ(e1,e2). \n(Has been moved to Clifford:-setu p).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 34. Procedure " }{TEXT 324 10 "scalarpart" }{TEXT -1 137 " computes the scalar part of the gi ven Clifford polynomial. For example, scalarpart(e1 + e2we3) = 0 but scalarpart(2*Id + e2we3) = 2. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 46 "Typical use: scalarpart(2*Id + e1 + e1w e2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 372 "scalarpart:=proc(a::\{ cliscalar,clibasmon,climon,clipolynom\}) local a1,p; \noptions `Copyri ght (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n############ #################################\na1:=simplify(a):\nif type(a1,clisca lar) then return a1 end if;\np:=clicollect(a1):\nreturn coeff(p,Id);\n end 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 593 "vecto rpart:=proc(a::\{cliscalar,clibasmon,climon,clipolynom\},a2::nonnegint ) \nlocal a1,p,K;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: July 22, 2006`;\n#############################################\na 1:=expand(simplify(a)): #expand is needed\nif maxgrade(a1) < a2 then r eturn 0 end if;\n K:=proc() if maxgrade(args[1])=a2 then true else f alse end if end proc:\nif type(a1,`+`) then p:=select(K,a1) elif\n m axgrade(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 1356 "cexp:=proc(p::\{numeric ,cliscalar,clibasmon,climon,clipolynom\},N::nonnegint) \nlocal pp,k,an s,ans1,ans2,lname,coB,nameB;\noptions `Copyright (c) 1995-2006 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\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,arra y\}) 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 n ameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3] :\n else \n error \"wrong type of third argument in cexp. See ?cexp for more help.\" \n end if;\nelse\n error \"two or three a rguments 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)) \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:=cexp(pp,N-1,lname);\n \+ ans2:=cexp(pp,N-2,lname);\n ans:=ans1+cmul[lname](((ans1-ans 2)*(N-1)!),pp)/N!;\n return ans;\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 37. Procedure " }{TEXT 327 5 "cexpQ" } {TEXT -1 257 " computes Clifford exponential of a Clifford number in C l(Q) up to the order specified by the second argument which is a nonn egative integer n. It n = 0 then this procedure returns 'Id'. This pr ocedure 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 1370 "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-2006 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: July 22, 2006`;\n########################################## ###\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \+ \nelif nargs=3 then\n if type(args[3],\{name,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3];\n lname:=args[3]; \n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array\})) th en\n coB:=op(select(type,\{op(args[3])\},numeric));\n name B:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \n error \"wrong type of third argument in cexpQ. See ? cexpQ for more help.\" \n end if;\nelse\n error \"two or three ar guments 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 \nend \+ if;\npp:=clisort(displayid(p)):\nif N=0 then return Id \n elif N=1 t hen 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 "w exp" }{TEXT -1 168 " computes exterior exponential of a Clifford numbe r u up to the order specified by the second argument which is a nonne gative 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 607 "wexp:= proc(p: :\{cliscalar,clibasmon,climon,clipolynom\},N::nonnegative) \nlocal pp, power,cu,i;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: J uly 22, 2006`;\n#############################################\n if na rgs<>2 then error \"two parameters are needed in 'wexp'\" end if;\n p p:=expand(p);\n if N=0 then return 1 elif\n N=1 then return 1+cli sort(pp) end if;\n power:=pp;\n cu:=1+pp;\n for i from 2 to N do\n \+ power:=wedge(power,pp);\n cu:=cu + power/i!;\n end do;\n ret urn subs(Id=1,clicollect(clisort(cu)));\n end proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 18 "No. 39. Procedure " }{TEXT 329 9 "reversion" } {TEXT -1 411 " calculates reversion in the Clifford algebra. It is lin ear in its argument and it is always a Clifford algebra anti-automorph ism. When the antisymmetric part of B is not zero, 'reversion' does n ot preserve the multilinear structure of the algebra because it mixes \+ grades, i.e., it does not preserve the gradation of the exterior algeb ra. This procedure can now take a third optional argument such as B o r -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 2636 "reversion:=proc(a1::\{cliscalar,clibasmon ,climon,clipolynom,matrix\}) \n local ind,expr,wtp,ptw,lname ,flagindexed;\n global _scalartypes,B;\noptions `Copyright ( c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: July 22, 2006`;\n################# ############################\nif hastype([args[1]],cliprod) then \n \+ error \"in order to handle 'type/cliprod', load in package Cliplus\" \+ \n end if;\n############################\nif type(a1,cliscalar) then r eturn a1 end if;\n############################\nif nargs=1 then\n l name:=`B`;\n flagindexed:=false:\nelif nargs=2 and type(args[2],\{s ymbol,name,array,matrix,`&*`(algebraic,name)\}) then\n lname:=args[ 2];\n flagindexed:=true:\nelse error \"only one or two arguments ar e expected\"\nend if;\n############################\n### Auxiliary fun ction that converts wedges to Clifford products: wedge ->> Clifford pr oduct\n############################\nwtp:=proc(a1,lname) local ind,i,a rg,rdmon,eq1,ans; global _scalartypes; \nif type(a1,\{`+`,`*`\}) the n return (map(wtp,a1,lname)) \n elif type(a1,_scalartypes) then retu rn 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:=C lifford:-extract(a1,'integers'):\ni:='i':\narg:=[seq(cat(e,op(ind[i])) ,i=1..nops(ind))];\neq1:=cat(op(arg))=simplify(eval(cmul[lname](op(arg ))));\nif a1=rdmon then ans:=simplify(solve(eq1,a1)) \n els e ans:=-simplify(solve(-eq1,-rdmon)) \nend if;\nif nops(ind) < 4 th en return ans else return wtp(ans,lname) end if;\nend proc:\n######### ###################\n### Auxiliary function that converts Clifford pro ducts to wedge: Clifford products ->> wedge\n######################### ###\nptw:=proc(a1,lname) local i,arg,revarg; global _scalartypes; \nif type(a1,\{`+`,`*`\}) then return (map(ptw,a1,lname)) \n elif type(a 1,_scalartypes) then return a1 \n elif type(a1,symbol) and SearchTex t(e,a1)=0 then return a1 \n elif type(a1,symbol) and length(a1)=2 th en return a1 \n elif type(a1,symbol) and not member(length(a1),\{2,4 ,6,8,10,12,14,16,18\})\n then return a1 \n end if;\ni:='i':\nar g:=[seq(cat(e,substring(a1,2*i..2*i)),i=1..(length(a1)/2))];\nrevarg:= [seq(arg[nops(arg)-i],i=0..(nops(arg)-1))];\nreturn expand(eval(cmul[l name](op(revarg))))\nend proc:\n##############################\n### No w the actual function:\n##############################\nif type(a1,mat rix) then return map(reversion,a1,lname) end if;\nexpr:=ptw(expand(wtp (a1,lname)),lname);\nexpr:=expand(displayid(expr)):\nreturn clisort(ex pr)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 40. Procedure \+ " }{TEXT 330 11 "conjugation" }{TEXT -1 317 " calculates conjugation i n the Clifford algebra. It is linear in its argument. Note that 'conj ugation' is defined as a composition of 'reversion' and 'gradeinv'. H ence, it does not preserve the multivector gradation when the antisymm etric part of B is non-zero. It can now accept optional argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 41 "Typical use: conjugation(e1 + 4*e2we3); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 820 "conjugation:= proc(a1::algebraic) local lname;global B;\noptions `Copyright (c) 1995 -2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: July 22, 2006`;\n######################## #####################\nif nargs=1 then\n lname:=`B`;\nelif nargs=2 \+ and type(args[2],\n \{symbol,name,array,matrix,`&*`(numeric,\{symb ol,name,array,matrix\})\}) then\n lname:=args[2];\nelse error \"onl y one or two arguments are expected\"\nend if;\n###################### #####\nif type(a1,matrix) then return map(procname,a1,lname) elif\n \+ type(a1,cliscalar) then return a1 elif\n type(a1,\{clibasmon,climon, clipolynom\}) then\n return eval(gradeinv(reversion(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; thus, " }}{PARA 258 "" 0 "" {TEXT -1 80 " c_conjug(u) = c_c onjug(a + I*b) = a - I*b " }}{PARA 258 "" 0 "" {TEXT -1 140 "where \+ a and b are in the real Clifford algebra and `I` is the imaginary unit , i.e., I = sqrt(-1). This procedure is linear in its argument. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 51 "Typic al use: c_conjug((1 + 2*I)*e1 - 3*I*e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 694 "c_conjug:=proc(a1::algebraic) local ba,co,terms,t,i; \noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: July 22, 200 6`;\n#############################################\nif type(a1,matrix) then return map(procname,a1) elif\n type(a1,cliscalar) then return \+ conjugate(a1) elif\n type(a1,\{clibasmon,climon,clipolynom\}) then\n t:='t':\n ba:=cliterms(a1);\n co:=[coeffs(a1,ba, 't')];\n terms:=[t];i:='i':\n return clisort(add(conjuga te(co[i])*terms[i],i=1..nops(co)))\n else \nerror \"wrong input type : input must be of type cliscalar, clibasmon, climon, clipolynom, or ' matrix'\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 42. Procedure " }{TEXT 332 6 "buildm" }{TEXT -1 863 " builds a matrix for the given element u of the Clifford algebra Cl(B) in the left- or right-regular representation, or under Lie or automorphism action wit h respect to an ordered basis specified by the user. The element p is entered as the first argument and the basis in the form of a list is \+ specified as the second argument, e.g., buildm(u, basis). It is also \+ possible to specify options 'left', 'right', 'Lie', 'auto', 'false, an d 'true'. For example, one can find the left-regular representation of the algebra on itself or, when Cl(B) is simple and isomorphic to a ri ng of real matrices, one can find matrices representing Clifford polyn omials in a real basis of a minimal ideal. However, there are new pro cedures below specifically designed for finding spinor representations of Clifford algebras in terms of real, complex, and quaternionic matr ices. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 270 "Typical use: \n\nbuildm(e1, [Id, e1, e2, e1we2]); buildm(e1, [ Id, e1, e2, e1we2], 'right'); buildm(e1, [Id, e1, e2, e1we2], 'Lie'); \nbuildm(e2, [Id, e1, e2, e1we2],'false'); buildm(e1we2+e2, [Id, e1, e 2, e1we2], 'true'); buildm(e1, [Id, e1, e2, e1we2], 'Lie','false'); \+ \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2964 "buildm:=proc(a1::\{cliscal ar,clibasmon,climon,clipolynom\},\n a2::list(\{cliscalar,c libasmon,climon,clipolynom\}))\nlocal A,L,N,a11,xm,i,j,Lbasis,neq,vars ,sys,sol,nontrivial,a33,flag;\noptions `Copyright (c) 1995-2006 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: July 22, 2006`;\n#################################### #########\nflag:=true:\nif nargs=2 then a33:='left' end if;\nif nargs= 3 then \n if member(args[3],\{'true','false'\}) then flag:=args[3]; \n a33:='left';\n elif m ember(args[3],\{'left','right','Lie','auto'\}) \n \+ then a33:=args[3]\n else error \"third optional ar gument must be 'left', 'right', 'Lie', 'auto', 'true', 'false'\"\n e nd if; \nend if;\nif nargs=4 then\n if member(args[3],\{'left','righ t','Lie','auto'\}) and member(args[4],\{'false','true'\}) then\n \+ a33:=args[3]; \n flag:=args[4];\n else \n error \"t hird optional argument must be 'left', 'right', 'Lie', 'auto', and the fourth optional argument must be 'false' or 'true'\"\n end if;\nend if;\nif nargs>4 then error \"too many arguments. See ?buildm for more help.\" end if;\n#################################################\ni f 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 'findbasis' to this list first. \",a2 \nend if;\nend if;\n###local procedure\nnontrivial:=proc(S::\{se t(\{relation,algebraic\}),list(\{relation,algebraic\})\}) \nlocal istr ivial;\nprintlevel:=2:\nistrivial:=proc(x) if type(x,relation) then ev alb(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 f or i from 1 to N do \n eq||i:=clicollect(expand(cmul(a1,L[i])-a dd(xm[j,i]*L[j],j=1..N))) \n end do;\nelif a33='right' then \n f or 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(cm ul(L[i],a1)-cmul(a1,L[i])-add(xm[j,i]*L[j],j=1..N)))\n end do;\nel if 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]),a1 1)-add(xm[j,i]*L[j],j=1..N)))\n end do;\nelse error \"third option al argument must be 'left', 'right', 'Lie', or 'auto'\"\nend if;\n#### ######################################################\nLbasis:=[op(`u nion` (seq(cliterms(L[i]),i=1..N)))];\nfor 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(evalm(xm),set):sys:=map(op,\{entr ies(neq)\});\nsys:=nontrivial(sys): #eliminate 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 "findbasis" }{TEXT -1 680 " finds a basis in a linear vector space spanned by a set of Clifford polynom ials entered as a list. The procedure is used, for example, when fin ding a basis for a spinor space S considered as a minimal left or righ t ideal in Cl(B) generated by a primitive idempotent f. To speed up co mputations, it is advisable to a standard Clifford basis for Cl(B) in \+ the form of a list of basis monomials as the second argument. If only one list is specified, 'findbasis' determines a suitable Clifford bas is itself but it takes twice as much time then since it creates a Clif ford basis by using 'cbasis(maxindex)' where 'maxindex' is the maximum index found among the elements of the list." }}{PARA 258 "" 0 "" {TEXT -1 69 "\nTypical use: findbasis([2*e1+e2,e2+e1we2,e1we2],[Id,e1, e2,e1we2]);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1474 "findbasis:=proc (a1,a2) local L,clibasis,M,i,m,r,v,S; \nglobal _prolevel;\noptions `Co pyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: July 22, 2006`;\n######## #####################################\nif evalb(_prolevel=false) then \n if nargs=1 and not (type(a1,list(\{clibasmon,climon,clipolynom\}) ) or \n type(a1,set(\{clibasmon,climon,clipolyno m\}))) then\nerror \"argument of type list/set(\{clibasmon,climon, or \+ clipolynom\}) was expected\"\n elif nargs=2 and \n not ((type(a 1,list(\{clibasmon,climon,clipolynom\})) or \n type(a1, set (\{clibasmon,climon,clipolynom\}))) and \n (type(a2,list(cli basmon)) or type(a2,set(clibasmon)))) or nargs>2 then\nerror \"argumen ts of type list/set(\{clibasmon,climon,clipolynom\}) and list/set(clib asmon) were expected\" \nend if;\nend if;\nif nops(a1)=1 then return a 1 end if;\n#L:=sort(map(displayid,convert(a1,list)),bygrade):\nL:=map( displayid,convert(a1,list)): ####NO SORT\nif nargs=2 then clibasis:=so rt(convert(a2,list),bygrade) else \n clibasis:=sort(convert(`union`( op(map(cliterms,L))),list),bygrade);\nend if;\nM:=linalg[genmatrix](L, clibasis);\nr:=linalg[rank](M):m:=linalg[rowdim](M):\nfor i from 1 to \+ m do v[i]:=linalg[row](M,i) end do;\nS:=[v[1]]:\nfor i from 2 to m whi le nops(S) < r do \n if linalg[rank](linalg[stackmatrix](op(S),v[i] ))=nops(S)+1 \n then S:=[op(S),v[i]] \n end if\nend do;\nretu rn [seq(L[i],i=map(op,S))]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 44. Procedure " }{TEXT 334 12 "minimalideal" }{TEXT -1 143 " c alculates a real basis for a left S=Cl(B)f or right S=fCl(B) minimal i deal in the algebra Cl(B) where f is a primitive idempotent in Cl(B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 151 "The first argument of the procedure is an ordered list of basis monom ials sorted bygrade, e.g., a Clifford basis generated by the procedure 'cbasis'. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 198 "Note: to sort a list L by grade one may use sort(L, byg rade) where 'bygrade' is a new procedure in this package described be low. The output from the procedure 'cbasis' is already sorted that wa y." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 392 "The second argument is the idempotent f. If the idempotent f is \+ the same as the one stored under clidata()[4] then 'minimalideal' us es the generators of S stored under clidata()[5] to generate the real \+ basis and it returns the stored list clidata()[5] as the second list in its ouput. If f does not equal clidata()[4] then complete comput ations 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 specified.\n\nThe procedure returns a list consisting of two ordered lists: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 91 "(1) the first list contains the real basis of S written as expanded Clifford polynomials; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 106 "(2) the se cond list contains basis monomials from the standard basis in Cl(B) wh ich generate the " }}{PARA 258 "" 0 "" {TEXT -1 108 " fir st 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 bet ween the two ordered lists.\n\nTypical use: minimalideal([Id,e1,e2,e3, e1we2,e1we3,e2we3,e1we2we3],(1/2)*(Id+e3),'left');\n \+ minimalideal([Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3],(1/2)*(Id+ e3),'right');\n" }{MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2243 "minimalideal:=proc(a1,a2,a3) \nlocal L,gens,m,flag1,f,flag_left, data,SB,g,SBgens,pq,p,q,l,ni,realdim,dimoverK,cb,N,bel; \nglobal B,_sh ortcut_in_minimalideal,_prolevel;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescri ption `Last revised: July 22, 2006`;\n################################ #############\nif not type(B,diagmatrix) then \n error \"bilinear fo rm B has not been assigned a matrix or is not diagonal\" \nend if; \ni f not _prolevel then\n if not type(a1,list(\{clibasmon,climon,clipol ynom\})) then\n error \"first argument must of type list(\{cl ibasmon,climon,clipolynom\})\" \n elif not type(a2,'primitiveidem p') then \n error \"second argument must be a primitive \+ idempotent\" \n elif not member(a3,\{'left','right',\"left\" ,\"right\"\}) then\n error \"third argument must be 'left', or 'right'\" \n end if;\n end if;\nf:=displayid(eval(a2)):\ni f member(a3,\{'left',\"left\"\}) then flag_left:=true else flag_left:= false end if;\ng:='g':\nL:=sort(a1,bygrade):\nif _shortcut_in_minimali deal 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]))=gradeinv(f) then\n SBgens:=data[5]: \n if flag_left then SB:=[seq(cmulQ(g,f),g=SBgens)] else \n \+ SB:=[seq(cmulQ(f,g),g=SBgens)] \n end if;\n return [SB,SBgens,a3];\n end if;\n end if;\nend \+ if; \n#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);\ni f member((p-q) mod 8,\{0,1,2\}) then \n realdim:=2*ni; \n di moverK:=2*ni; \nelif member((p-q) mod 8,\{3,7\}) then \n realdim: =4*ni; \n dimoverK:=2*ni; \nelse\n realdim:=4*ni; \n di moverK:=ni \nend if;\ngens:=clidata()[5]: #put elements from clidata() [5] first in L\nL:=remove(member,L,gens):\nL:=[op(gens),op(L)]:\nSB:=[ f]:SBgens:=[Id]:cb:=remove(member,L,[Id]); \nfor g in cb while nops(SB ) < realdim do\n N:=nops(SB):\n if flag_left then bel:=cmulQ(g,f ) else bel:=cmulQ(f,g) end if; \n SB:=findbasis([op(SB),bel]); \n \+ if nops(SB)>N then SBgens:=[op(SBgens),g] end if;\nend do:\nreturn \+ [SB,SBgens,a3];\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 48. Procedure " }{TEXT 335 6 "Kfield" }{TEXT -1 340 " computes a basis f or a field K. The field K is the field of the spinor space S = Cl(B)f or S = fCl(B) of the given Clifford algebra Cl(B). It 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, respectiv ely (here [p,q] is the signature of B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 205 "Assuming that the bilinear f orm B has been defined, the first argument of the procedure is expecte d to be the same as the output from the procedure 'minimalideal'. The second argument is the idempotent f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 225 "The procedure eliminates from the list of basis elements in the real ideal space nilpotent elements and leaves only those whose square modulo f is either +1 or -1. It retur ns those elements as the 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 st ored under clidata()[5], then the procedure" }}{PARA 258 "" 0 "" {TEXT -1 99 "uses generators of K stored under clidata()[6] and retur ns 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 generators (Clifford basis monomials) of the elements in the first list. Elements of the two lists are in one-to-one relat ionship. " }}{PARA 258 "" 0 "" {TEXT -1 204 "\nTypical use: dim:=2:B: =linalg[diag](1,-1):clibasis:=cbasis(dim):data:=clidata(B):f:=data[4]: \n sbasis:=minimalideal(clibasis,f,'left'); \n Kfield(sbasis,f);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4629 "Kfield:=proc(a1::list(\{list,string,symbol\}),a2::c lipolynom) \nlocal SB,gens,f,ff,k,n,fg,f_from_data,field,flag3,side,ex pr,i,ijk,g,dimen,Kbasis,Kgens,Kdim,data,T4: \nglobal B,_shortcut_in_Kf ield,_prolevel;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: July 22, 2006`;\n#############################################\n### # Local procedure needed only in 'Kfield' ###\nT4:=proc() \nlocal gens ,Kbasis,f,mi,clibas,clibas2,x,y,z; global B;\nKbasis:=args[1];f:=Kbasi s[1];mi:=max(op(map(maxindex,Kbasis)));\nclibas:=subsop(1=NULL,cbasis( mi));\nif type(B,matrix) then gens:=subsop(1=NULL,clidata()[6]);\n \+ clibas:=remove(member,clibas,gens):\n \+ clibas:=[op(gens),op(clibas)];\nend if;\nclibas2:=[]:\nfor x in c libas do \n if evalb(cmul(x,x) = -Id) then clibas2:=[op(clibas2),x] end if; \nend do:\nfor x in clibas2 do \nfor y in remove(member,cliba s2,[x]) do\nfor z in remove(member,clibas2,[x,y]) do\n if member( cmul(x,f),\{Kbasis[2],-Kbasis[2]\}) then \n if member(cmul(y,f ),\{Kbasis[3],-Kbasis[3]\}) then\n if member(cmul(z,f),\{Kb asis[4],-Kbasis[4]\}) then \n if type([x,y,z],'purequatb asis') 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,'primitivei demp') then \n error \"second argument must be a primitive idempo tent\"\n end if;\nend if;\n######################################### #####\nSB:=a1[1]:gens:=a1[2]:side:=a1[3]:f:=eval(a2):i:='i':g:='g':\n# #############################################\nif not member(f,SB) the n \n error \"idempotent entered %1 is not a member of the first list \",f \nend if;\n###new line here instead of >>>not assigned(B)<<<\nif \+ not type(B,matrix) then \n error \"matrix must be assigned to B\" \n end if;\nif side='right' then flag3:=true else flag3:=false end if;\nd ata:=clidata():\nfield:=data[1]:\nif field = 'real' then return [[f],[ Id]] \nelif field = 'complex' then \n if _shortcut_in_Kfield t hen\n f_from_data:=eval(eval(data[4])):\n fg:=grad einv(f): \n if member(f_from_data,\{f,-f,fg,-fg\}) and gens =data[5] then \+ Kgens:=data[6];\nif flag3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2. .nops(Kgens))]\n else Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2..nop s(Kgens))] \nend if;\nreturn ([Kbasis,Kgens]) \nend if;\nend if;\n#### #############################################################\n#Do thi s 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:=cmu l(f,gens[i],f);\n if expr<>0 then Kbasis:=[op(Kbasis),SB[i]]; \n Kgens:=[op(Kgens),gens[i]] \n e nd if;\n end if:\nend do;\nreturn [Kbasis,Kgens];\n################ ###############################################\nelif field = 'quatern ionic' then \n dimen:=linalg[coldim](B):\n if dimen=2 then Kba sis:=[op(SB)];\n Kgens:=[op(gens)];\n \+ return [Kbasis,Kgens]\n elif member(dimen,\{3,4,5,6,7,8,9 \}) then\n if _shortcut_in_Kfield then\n f_from_ data:=eval(eval(data[4])):\n fg:=gradeinv(f): \n \+ if member(f_from_data,\{f,-f,fg,-fg\}) and gens=data[5] then \+ Kgens:=data[6] ;\nif flag3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2..nops(Kgens))]\n \+ else \n Kbasis:=[f,seq(cmul(f,Kgens[ i]),i=2..nops(Kgens))] \nend if;\nreturn [Kbasis,Kgens] \nend if;\nend if;\nend if;\n####################################################### #########\n#Do this when shortcut can't be used and field = 'quaternio nic'\n################################################################ \nKdim:=4:\nKbasis:=[f]:Kgens:=[Id]:\nn:=nops(gens):\nfor i from 1 to \+ n while nops(Kbasis) < Kdim do\n if cmul(gens[i],gens[i])=-Id then \n expr:=cmul(f,gens[i],f);\n if expr<>0 then Kbasis :=[op(Kbasis),SB[i]];\n Kgens:=[op(Kgens),ge ns[i]] \n end if;\n end if:\nend do;\n################### #########\n ijk:=T4(Kbasis);\n############################\n K gens:=[Id,op(ijk)]:\nif flag3 then Kbasis:=[f,seq(cmul(g,f),g=ijk)] el se \n Kbasis:=[f,seq(cmul(f,g),g=ijk)]\nend if;\nreturn [ Kbasis,Kgens]\nelse error \"wrong name of the field. See ?Kfield for m ore help.\" \nend if;\nend 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 iso morphic to the reals, or to the complexes, or to the quaternions acco rding to whether (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, res pectively (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 mini mal ideal Cl(B)f or fCl(B) (it doesn't matter whether the ideal was le ft or right). These generators are found by the procedure 'minimalide al' and are returned by it as a second list." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 104 "The second argument is the 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 argument is a list FBgens of generators that g enerate the field K; these generators are returned as a second list by the procedure 'Kfield'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 143 "The fourth argument is either 'left' or 'rig ht' depending whether we deal with the left minimal ideal Cl(B)f or th e 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 in put match respectively clidata()[5], clidata()[4], and clidata()[6] \+ in that order, i.e., SBgens=clidata()[5], f=clidata()[4], and FBgens =clidata()[6], then the procedure finds previously computed generators of S over K which are stored as clidata()[7]. These generators are t hen used to compute the K-basis for S=Cl(B)f or S=fCl(B) depending whe ther the fourth argument is 'left' or 'right'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 47 "The procedure returns a list of three elements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 163 "(1) the first list is an ordered list of Cli fford polynomials which give a basis in Cl(B)f or fCl(B) (depending o n what was the fourth argument in the procedure);" }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 178 "(2) the second list \+ is an ordered list of generators over f which give the elements in the first list. There is a one-to-one correspodence between the elements of the two lists." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 254 "(3) the third element in the output is either 'left ' or 'right' and it matches the fourth argument in the input to the pr ocedure. That element is to remind the user that the basis returned a s the first list is for the left or right ideal respectively. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 334 "Typi cal use: dim:=2:B:=linalg[diag](1,-1):clibasis:=cbasis(dim):data:=clid ata(B):f:=data[4]:\n sbasis:=minimalideal(clib asis,f,'left');\n fbasis:=Kfield(sbasis,f);\n \+ SBgens:=sbasis[2];FBgens:=fbasis[2];\n \+ spinorKbasis(SBgens,f,FBgens,'left')\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 2861 "spinorKbasis:=\nproc(a1::list,a2::\{clibasmo n,climon,clipolynom\},a3::list,a4::\{string,symbol\}) \nlocal flag,fla g_left,Kdim,f,SBgens,SB,FBgens,g,SBKbasis,SBKgens,data,i,poss,m,p; \ng lobal B,_shortcut_in_spinorKbasis,_prolevel;\noptions `Copyright (c) 1 995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: July 22, 2006`;\n##################### ########################\nif not type(B,matrix) then \n error \"matr ix must be assigned to B\" \nend if;\nif not _prolevel then\n if not type(a2,'idempotent') then \n error \"second argument must be an idempotent\" elif\n not member(a4,\{'left','right',\"left\",\"right \"\}) then \n error \"the fourth argument must be 'left', or 'rig ht'\"\n end if;\nend if;\nSBgens:=a1:f:=eval(a2):FBgens:=a3:\nif SBg ens=FBgens then return [[f],[Id],a4] end if;\nif a4='left' or a4=\"lef t\" then flag_left:=true else flag_left:=false end if;\ndata:=clidata( ):\nif _shortcut_in_spinorKbasis 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(cmu lQ(f,g),g=SBKgens)]\n end if; \n return [SBKbasis,SBKgens ,a4];\n end if;\nend if; \nKdim:=nops(FBgens):SB:=[]:\ng:='g':\nif \+ flag_left then SB:=[seq(cmulQ(g,f),g=SBgens)] \n else SB:= [seq(cmulQ(f,g),g=SBgens)]\nend if;\nif Kdim=1 then return [SB,SBgens, a4] end if;\nm:=max(op(map(maxindex,SBgens)));\nposs:=cbasis(m);\nSBKg ens:=[Id]:\ng:='g':\nif flag_left then SB:=remove(member,SB,[seq(cmul( f,g),g=FBgens)])\n else SB:=remove(member,SB,[seq(cmul(g,f ),g=FBgens)])\nend if;\nposs:=remove(member,poss,FBgens);\nfor g in po ss 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 fr om 1 to Kdim do p[i]:=cmul(FBgens[i],f,g) end do;\n end if; \n \+ for i from 1 to Kdim do\n flag[1,i]:=member(p[i],SB): \n \+ flag[2,i]:=member(-p[i],SB):\n end do;\n if Kdim=2 then \+ \n if (flag[1,1] or flag[2,1]) and (flag[1,2] or flag[2,2]) th en\n SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2]]):\n \+ SBKgens:=[op(SBKgens),g]\n end if:\n else\n if (flag[1 ,1] or flag[2,1]) and \n (flag[1,2] or flag[2,2]) and\n \+ (flag[1,3] or flag[2,3]) and\n (flag[1,4] or flag[2,4])\n \+ then\n SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2],p[3],-p[ 3],p[4],-p[4]]):\n SBKgens:=[op(SBKgens),g]\n end if:\n \+ end if;\n if flag[1,1] then SBKbasis:=[op(SBKbasis),p[1]] else\n \+ SBKbasis:=[op(SBKbasis),-p[1]] \n end if;\n \+ end do;\ng:='g':\nif flag_left then SBKbasis:=[seq(cmul(g,f),g=SBKgen s)] else\n SBKbasis:=[seq(cmul(f,g),g=SBKgens)]\nend \+ if;\nreturn [SBKbasis,SBKgens,a4]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 47. Procedure " }{TEXT 337 10 "squaremodf" }{TEXT -1 390 " computes the square of a basis element u in a left or right mini mal ideal Cl(B)f or fCl(B) entered as the first argument modulo a pri mitive idempotent f entered as the second argument. The procedure do esn't check whether f is primitive or not. Thus, the procedure return s 1 or -1 depending whether cmul(u,u) = f or cmul(u,u) = -f. The pro cedure returns 0 if u is a nilpotent element." }}{PARA 258 "" 0 "" {TEXT -1 115 "\nThis procedure is needed to identify/verify squares of the basis elements in the field K of the spinor ideal S. \n" }} {PARA 258 "" 0 "" {TEXT -1 54 "Typical use: squaremodf((1/2)*(Id+e1),( 1/2)*(Id+e1);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 780 "squaremodf:=pr oc(a1::\{clibasmon,climon,clipolynom\},a2::idempotent) \nlocal p;globa l B;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n#############################################\nif nargs<>2 th en \n error \"two arguments needed of type clibasmon, or climon, or \+ clipolynom, and 'idempotent'\" \nend if;\nif a1=a2 then return 1 elif \n not type(B,matrix) then error \"matrix must be assigned to B\" \n end if;\np:=cmul(a1,a1):\nif expand(p-a2)=0 then return 1 elif\n exp and(p+a2)=0 then return -1 elif\n (p=0 or type(a1,nilpotent)) then r eturn 0 else \n error \"either element %1 is not a basis elem ent or it does not belong to the spinor space Cl(Q)f (or fCl(Q))\",a1 \+ \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 48. Proc edure " }{TEXT 338 8 "RHnumber" }{TEXT -1 76 " gives the Radon-Hurwitz number for any integer.\n\nTypical use: RHnumber(2);\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 501 "RHnumber:=proc(a1::integer)\noptions `Copyrig ht (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: July 22, 2006`;\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 re turn 3 elif\n a1>=8 then return 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 containing basic information about the o rthogonal Clifford algebra Cl(Q) of the given bilinear form B (assumed to have been diagonalized). The procedure must be called with B, or \+ with a signature of B given as a list [p,q], or simply as clidata() (c urrently defined B will then be used)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 47 "It returns a list with the foll owing 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) the 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 primitive idempotent f which may be us ed to generate a left or right minimal ideal in the algebra." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 574 "NOTE : the idempotents are stored here in an unevaluated form so that they \+ could be easily recognized as Clifford products of simpler projection \+ operators. The number of factors in these products is determined by \+ the value of q - RHnumber(q-p).\n\n(e) the fifth entry is a list of b asis monomials ordered by grade which generate Cl(Q)f and fCl(Q).\n\n( f) the sixth entry is a list of basis monomials ordered by grade which give a basis for K (this is in terms of these monomials that matrices representing Clifford polynomials will be written by the procedure 's pinorKrepr').\n" }}{PARA 258 "" 0 "" {TEXT -1 92 "(g) the seventh entr y is a list of basis monomials ordered by grade which generate S over \+ K." }}{PARA 258 "" 0 "" {TEXT -1 139 "\nIf the procedure is called as \+ 'clidata()' then it returns information about the Clifford algebra of \+ the 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 470 "clidata:=proc() local a1,clidata2;global B;\noptio ns `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n## ###########################################\nif nargs=0 then a1:=`B` e lse a1:=args end if:\nif not type(a1,\{list(nonnegint),matrix\}) then \n WARNING(\"to find out about Clifford algebra Cl_\{p,q\} try clida ta([p,q]) or enter ?clidata for more help\");\n return ('procname(ar gs)')\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 16597 ":=proc(a1::\{list(nonnegint),matrix\})\nlocal SBgens,FBgens,SBK gens,p,q,l,ni,K,dimoverK,dimoverR,numfact,struct,primidemp;\nglobal B; \noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`,remember;\ndescription `Last revised: Jul y 22, 2006`;\n#############################################\n#K = fiel d of spinor repesentation, it is R, C, or H depending on [p,q]\n#dimov erK = dimension of spinor representation over the field K\n#dimoverR = dimension of spinor representation over the reals R\n#numfact = numbe r of idempotent factors in any primitive idempotent\n#SBgens = basis m onomials generating Cl(Q)f and fCl(Q) over R\n#FBgens = basis monomial s providing a basis for K\n#SBKgens = basis monomials generating Cl(Q) f and fCl(Q) over K \n#p = number of +1 in the diagonal form Q of B\n# q = number of -1 in the diagonal form Q of B\n#struct = structure of C l(Q) is 'simple' or 'semisimple'\n#primidemp = primitive idempotent f \+ to generate Cl(B)f or fCl(B)\nif nargs=0 then\n###new line instead of \+ >>>not assigned(B)<<<\nif not type(B,matrix) then \n error \"matrix \+ must be assigned to B\" else\n return clidata(B)\nend if;\nend if ; \nif type(args[1],list(nonnegint)) then p:=args[1][1]:q:=args[1][2]: \n elif type(args[1],matrix) then \n p:=Bsignature(args)[1]; q:=Bsignature(args)[2] \n else \n error \"wrong argument typ es 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\" \nen d 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 membe r((p-q) mod 8,\{3,7\}) then \n K:='complex'; dimoverR:=2*2*ni; di moverK:=2*ni; else\n K:='quaternionic'; dimoverR:=4*ni; dimoverK: =ni \nend if;\nnumfact:=q-RHnumber(q-p);\nif modp((p-q) = 1,4) then st ruct:='semisimple' \n else struct:='simple' \nend if;\nprimidemp:=ta ble():SBgens:=table():FBgens:=table():SBKgens:=table():\n############# ############>>>DATA<<<#################################\n#Real, simple (13 cases)\nprimidemp[[0,0]]:=Id; #real numbers\nSBgens[[0,0]]:=[Id] ;\nFBgens[[0,0]]:=[Id];\nSBKgens[[0,0]]:=SBgens[[0,0]];\n\nprimidemp[[ 1,1]]:=(1/2)*(Id+e1we2);\nSBgens[[1,1]]:=[Id,e1];\nFBgens[[1,1]]:=[Id] ;\nSBKgens[[1,1]]:=SBgens[[1,1]];\n\nprimidemp[[2,0]]:=(1/2)*(Id+e1); \nSBgens[[2,0]]:=[Id,e2];\nFBgens[[2,0]]:=[Id];\nSBKgens[[2,0]]:=SBgen s[[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];\nSBKg ens[[2,2]]:=SBgens[[2,2]];\n\nprimidemp[[3,1]]:=\n''cmulQ''((1/2)*(Id+ e1),(1/2)*(Id+e3we4));\nSBgens[[3,1]]:=[Id,e2,e3,e2we3];\nFBgens[[3,1] ]:=[Id];\nSBKgens[[3,1]]:=SBgens[[3,1]];\n\nprimidemp[[0,6]]:=\n''cmul Q''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6));\nSBg ens[[0,6]]:=[Id,e1,e2,e3,e4,e5,e6,e1we5];\nFBgens[[0,6]]:=[Id];\nSBKge ns[[0,6]]:=SBgens[[0,6]];\n\nprimidemp[[3,3]]:=\n''cmulQ''((1/2)*(Id+e 1we4),(1/2)*(Id+e2we5),(1/2)*(Id+e3we6));\nSBgens[[3,3]]:=[Id,e1,e2,e3 ,e1we2,e1we3,e2we3,e1we2we3];\nFBgens[[3,3]]:=[Id];\nSBKgens[[3,3]]:=S Bgens[[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,e3 we4,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));\nSBgens[[4,4]]:=[Id,e1,e2,e3,e4,e1we2, e1we3,e1we4,e2we3,e2we4,e3we4,e1we2we3,\n e1we2we4,e1we3we4,e2we3we4,e 1we2we3we4];\nFBgens[[4,4]]:=[Id];\nSBKgens[[4,4]]:=SBgens[[4,4]];\n\n primidemp[[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,e2we3we 4we5];\nFBgens[[5,3]]:=[Id];\nSBKgens[[5,3]]:=SBgens[[5,3]];\n\nprimid emp[[8,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id +e4we5we6we7),\n (1/2)*(Id+e2we4we6we8));\nSBgens[[8,0]]:=[Id ,e2,e3,e4,e5,e6,e7,e8,e2we3,e2we4,e2we5,e2we6,e2we7,\ne2we8,e3we8,e2we 3we8];\nFBgens[[8,0]]:=[Id];\nSBKgens[[8,0]]:=SBgens[[8,0]];\n\nprimid emp[[1,7]]:=\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e4we5we6),(1/2)* (Id+e2we5we7),\n (1/2)*(Id+e1we8));\nSBgens[[1,7]]:=[Id,e1,e2 ,e3,e4,e5,e6,e7,e1we2,e1we3,e1we4,e1we5,e1we6,\ne1we7,e2we6,e1we2we6]; \nFBgens[[1,7]]:=[Id];\nSBKgens[[1,7]]:=SBgens[[1,7]];\n\nprimidemp[[0 ,8]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1 we4we6),\n (1/2)*(Id+e3we6we7));\nSBgens[[0,8]]:=\n[Id,e1,e2, e3,e4,e5,e6,e7,e8,e1we8,e2we8,e3we8,e4we8,e5we8,e6we8,e7we8];\nFBgens[ [0,8]]:=[Id];\nSBKgens[[0,8]]:=SBgens[[0,8]];\n\n#Complex, simple (15 \+ cases)\nprimidemp[[0,1]]:=Id; #complex numbers\nSBgens[[0,1]]:=[Id,e1 ];\nFBgens[[0,1]]:=[Id,e1];\nSBKgens[[0,1]]:=[Id,e1];\n\nprimidemp[[1, 2]]:=(1/2)*(Id+e1we3);\nSBgens[[1,2]]:=[Id,e1,e2,e1we2];\nFBgens[[1,2] ]:=[Id,e2];\nSBKgens[[1,2]]:=[Id,e1];\n\nprimidemp[[3,0]]:=(1/2)*(Id+e 1);\nSBgens[[3,0]]:=[Id,e2,e3,e2we3];\nFBgens[[3,0]]:=[Id,e2we3];\nSBK gens[[3,0]]:=[Id,e2];\n\nprimidemp[[0,5]]:=\n''cmulQ''((1/2)*(Id+e1we2 we3),(1/2)*(Id+e3we4we5));\nSBgens[[0,5]]:=[Id,e1,e2,e3,e4,e5,e1we4,e1 we5];\nFBgens[[0,5]]:=[Id,e3];\nSBKgens[[0,5]]:=[Id,e1,e4,e1we4];\n\np rimidemp[[2,3]]:=\n''cmulQ''((1/2)*(Id+e1we4),(1/2)*(Id+e2we5));\nSBge ns[[2,3]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\nFBgens[[2,3]]:=[ Id,e3];\nSBKgens[[2,3]]:=[Id,e1,e2,e1we2];\n\nprimidemp[[4,1]]:=\n''cm ulQ''((1/2)*(Id+e1),(1/2)*(Id+e4we5));\nSBgens[[4,1]]:=[Id,e2,e3,e4,e2 we3,e2we4,e3we4,e2we3we4];\nFBgens[[4,1]]:=[Id,e2we3];\nSBKgens[[4,1]] :=[Id,e2,e4,e2we4];\n\nprimidemp[[1,6]]:=\n''cmulQ''((1/2)*(Id+e2we3we 4),(1/2)*(Id+e4we5we6),(1/2)*(Id+e1we7));\nSBgens[[1,6]]:=[Id,e1,e2,e3 ,e4,e5,e6,e1we2,e1we3,e1we4,e1we5,e1we6,e2we5, \+ e2we6,e1we2we5,e1we2we6]; \nFBgens[[1,6]]:=[Id ,e4];\nSBKgens[[1,6]]:=[Id,e1,e2,e5,e1we2,e1we5,e2we5,e1we2we5];\n\npr imidemp[[3,4]]:=\n''cmulQ''((1/2)*(Id+e1we5),(1/2)*(Id+e2we6),(1/2)*(I d+e3we7));\nSBgens[[3,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2w e4,e3we4,\n e1we2we3,e1we2we4,e1we3we4,e2we3we4,e1we2we 3we4]; \nFBgens[[3,4]]:=[Id,e4];\nSBKgens[[3,4]]:=[Id,e1,e2,e3,e1we2,e 1we3,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,e2w e3,e2we4,e2we5,e3we4,e3we5,e4we5,\n e2we3we4,e2we3we5,e 2we4we5,e3we4we5,e2we3we4we5]; \nFBgens[[5,2]]:=[Id,e2we3];\nSBKgens[[ 5,2]]:=[Id,e2,e4,e5,e2we4,e2we5,e4we5,e2we4we5];\n\nprimidemp[[7,0]]:= \n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e4we5we6we7 ));\nSBgens[[7,0]]:=[Id,e2,e3,e4,e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2we 7,\n e4we6,e4we7,e2we4we6,e2we4we7]; \nFBgens[[7,0]]:=[ Id,e2we3];\nSBKgens[[7,0]]:=[Id,e2,e4,e6,e2we4,e2we6,e4we6,e2we4we6]; \n\nprimidemp[[0,9]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4w e5),(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,e3w e9,\n e4we8,e4we9,e5we8,e5we9,e6we8,e6we9,e7we8,e7we9,e8we9,e1we8we9, \n e2we8we9,e3we8we9,e4we8we9,e5we8we9,e6we8we9,e7we8we9];\nFBgens[[0, 9]]:=[Id,e8we9];\nSBKgens[[0,9]]:=[Id,e1,e2,e3,e4,e5,e6,e7,e8,e1we8,e2 we8,e3we8,e4we8,\n e5we8,e6we8,e7we8];\n\nprimidemp[[2 ,7]]:=\n''cmulQ''((1/2)*(Id+e3we4we5),(1/2)*(Id+e5we6we7),(1/2)*(Id+e1 we8),\n (1/2)*(Id+e2we9));\nSBgens[[2,7]]:=\n[Id,e1,e2,e3,e4, e5,e6,e7,e1we2,e1we3,e1we4,e1we5,e1we6,e1we7,e2we3,\n e2we4,e2we5,e2we 6,e2we7,e3we6,e3we7,e1we2we3,e1we2we4,e1we2we5,\n e1we2we6,e1we2we7,e1 we3we6,e1we3we7,e2we3we6,e2we3we7,e1we2we3we6,\n e1we2we3we7];\nFBgens [[2,7]]:=[Id,e5];\nSBKgens[[2,7]]:=\n[Id,e1,e2,e3,e6,e1we2,e1we3,e1we6 ,e2we3,e2we6,e3we6,e1we2we3,e1we2we6,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,e 5,e1we2,e1we3,e1we4,e1we5,e2we3,e2we4,e2we5,e3we4,\n e3we5,e4we5,e1we2 we3,e1we2we4,e1we2we5,e1we3we4,e1we3we5,e1we4we5,\n e2we3we4,e2we3we5, e2we4we5,e3we4we5,e1we2we3we4,e1we2we3we5,\n e1we2we4we5,e1we3we4we5,e 2we3we4we5,e1we2we3we4we5];\nFBgens[[4,5]]:=[Id,e5];\nSBKgens[[4,5]]:= \n[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4,e1we2we3,e1we2we 4,\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));\nSB gens[[6,3]]:=\n[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we4,e3we5, e3we6,e4we5,\n e4we6,e5we6,e2we3we4,e2we3we5,e2we3we6,e2we4we5,e2we4we 6,e2we5we6,\n e3we4we5,e3we4we6,e3we5we6,e4we5we6,e2we3we4we5,e2we3we4 we6,\n e2we3we5we6,e2we4we5we6,e3we4we5we6,e2we3we4we5we6];\nFBgens[[6 ,3]]:=[Id,e2we3];\nSBKgens[[6,3]]:=\n[Id,e2,e4,e5,e6,e2we4,e2we5,e2we6 ,e4we5,e4we6,e5we6,e2we4we5,e2we4we6,\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,e2we7we8,e4we6we8,e4we7we8,e2we4we6we8,\n e 2we4we7we8];\nFBgens[[8,1]]:=[Id,e2we3];\nSBKgens[[8,1]]:=\n[Id,e2,e4, e6,e8,e2we4,e2we6,e2we8,e4we6,e4we8,e6we8,e2we4we6,e2we4we8,\n e2we6we 8,e4we6we8,e2we4we6we8];\n\n#Quaternionic, simple (12 cases)\nprimidem p[[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\nprimi demp[[1,3]]:=(1/2)*(Id+e1we4);\nSBgens[[1,3]]:=[Id,e1,e2,e3,e1we2,e1we 3,e2we3,e1we2we3];\nFBgens[[1,3]]:=[Id,e2,e3,e2we3];\nSBKgens[[1,3]]:= [Id,e1];\n\nprimidemp[[4,0]]:=(1/2)*(Id+e1);\nSBgens[[4,0]]:=[Id,e2,e3 ,e4,e2we3,e2we4,e3we4,e2we3we4];\nFBgens[[4,0]]:=[Id,e2we3,e2we4,e3we4 ];\nSBKgens[[4,0]]:=[Id,e2];\n\nprimidemp[[1,5]]:=\n''cmulQ''((1/2)*(I d+e2we3we4),(1/2)*(Id+e1we6));\nSBgens[[1,5]]:=[Id,e1,e2,e3,e4,e5,e1we 2,e1we3,e1we4,e1we5,e2we5,e3we5,\n e4we5,e1we2we5,e1we3 we5,e1we4we5];\nFBgens[[1,5]]:=[Id,e2,e2we4,e4];\nSBKgens[[1,5]]:=[Id, e1,e5,e1we5];\n\nprimidemp[[2,4]]:=\n''cmulQ''((1/2)*(Id+e1we5),(1/2)* (Id+e2we6));\nSBgens[[2,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e 2we4,e3we4,\n e1we2we3,e1we2we4,e1we3we4,e2we3we4,e1we2 we3we4];\nFBgens[[2,4]]:=[Id,e3,e4,e3we4];\nSBKgens[[2,4]]:=[Id,e1,e2, e1we2];\n\nprimidemp[[5,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e5we6 ));\nSBgens[[5,1]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we 5,\n e2we3we4,e2we3we5,e2we4we5,e3we4we5,e2we3we4we5]; \nFBgens[[5,1]]:=[Id,e2we3,e2we4,e3we4];\nSBKgens[[5,1]]:=[Id,e2,e5,e2 we5];\n\nprimidemp[[6,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we 4we5));\nSBgens[[6,0]]:=[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3w e6,e4we6,\n e5we6,e2we3we6,e2we4we6,e2we5we6];\nFBgens[ [6,0]]:=[Id,e2we3,e3we5,e2we5];\nSBKgens[[6,0]]:=[Id,e2,e6,e2we6];\n\n primidemp[[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,e1 we4,e1we5,e1we6,e2we3,e2we4,e2we5,\n e2we6,e3we6,e4we6,e5we6,e1we2we3, e1we2we4,e1we2we5,e1we2we6,e1we3we6,\n e1we4we6,e1we5we6,e2we3we6,e2we 4we6,e2we5we6,e1we2we3we6,e1we2we4we6,\n e1we2we5we6];\nFBgens[[2,6]]: =[Id,e3,e3we5,e5];\nSBKgens[[2,6]]:=[Id,e1,e2,e6,e1we2,e1we6,e2we6,e1w e2we6];\n\nprimidemp[[3,5]]:=\n''cmulQ''((1/2)*(Id+e1we6),(1/2)*(Id+e2 we7),(1/2)*(Id+e3we8));\nSBgens[[3,5]]:=\n[Id,e1,e2,e3,e4,e5,e1we2,e1w e3,e1we4,e1we5,e2we3,e2we4,e2we5,e3we4,\n e3we5,e4we5,e1we2we3,e1we2we 4,e1we2we5,e1we3we4,e1we3we5,e1we4we5,\n e2we3we4,e2we3we5,e2we4we5,e3 we4we5,e1we2we3we4,e1we2we3we5,\n e1we2we4we5,e1we3we4we5,e2we3we4we5, e1we2we3we4we5];\nFBgens[[3,5]]:=[Id,e4,e5,e4we5];\nSBKgens[[3,5]]:=[I d,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\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,e2we5,e2we6,e3we4,e3we5,e3we6,e4we5, \n e4we6,e5we6,e2we3we4,e2we3we5,e2we3we6,e2we4we5,e2we4we6,e2we5we6, \n e3we4we5,e3we4we6,e3we5we6,e4we5we6,e2we3we4we5,e2we3we4we6,\n e2we 3we5we6,e2we4we5we6,e3we4we5we6,e2we3we4we5we6];\nFBgens[[6,2]]:=[Id,e 2we3,e2we4,e3we4];\nSBKgens[[6,2]]:=[Id,e2,e5,e6,e2we5,e2we6,e5we6,e2w e5we6];\n\nprimidemp[[7,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3 we4we5),(1/2)*(Id+e7we8));\nSBgens[[7,1]]:=\n[Id,e2,e3,e4,e5,e6,e7,e2w e3,e2we4,e2we5,e2we6,e2we7,e3we6,e3we7,e4we6,\n e4we7,e5we6,e5we7,e6we 7,e2we3we6,e2we3we7,e2we4we6,e2we4we7,e2we5we6,\n e2we5we7,e2we6we7,e3 we6we7,e4we6we7,e5we6we7,e2we3we6we7,e2we4we6we7,\n e2we5we6we7];\nFBg ens[[7,1]]:=[Id,e2we3,e3we5,e2we5];\nSBKgens[[7,1]]:=[Id,e2,e6,e7,e2we 6,e2we7,e6we7,e2we6we7];\n\n#Real, semi-simple (8 cases)\nprimidemp[[1 ,0]]:=(1/2)*(Id+e1);\nSBgens[[1,0]]:=[Id];\nFBgens[[1,0]]:=[Id];\nSBKg ens[[1,0]]:=SBgens[[1,0]];\n\nprimidemp[[2,1]]:=\n''cmulQ''((1/2)*(Id+ e1),(1/2)*(Id+e2we3));\nSBgens[[2,1]]:=[Id,e2];\nFBgens[[2,1]]:=[Id]; \nSBKgens[[2,1]]:=SBgens[[2,1]];\n\nprimidemp[[3,2]]:=\n''cmulQ''((1/2 )*(Id+e1),(1/2)*(Id+e2we4),(1/2)*(Id+e3we5));\nSBgens[[3,2]]:=[Id,e2,e 3,e2we3];\nFBgens[[3,2]]:=[Id];\nSBKgens[[3,2]]:=SBgens[[3,2]];\n\npri midemp[[0,7]]:= ''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2 )*(Id+e1we4we6),\n (1/2)*(Id+e3we6we7));\nSBgens[[0,7]]:=[Id, e1,e2,e3,e4,e5,e6,e7];\nFBgens[[0,7]]:=[Id];\nSBKgens[[0,7]]:=SBgens[[ 0,7]];\n\nprimidemp[[4,3]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we5) ,(1/2)*(Id+e3we6),\n (1/2)*(Id+e4we7));\nSBgens[[4,3]]:=[Id,e 2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\nFBgens[[4,3]]:=[Id];\nSBKgens[[4 ,3]]:=SBgens[[4,3]];\n\nprimidemp[[9,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1 /2)*(Id+e2we3we4we5),1/2*(Id+e2we3we6we7),\n (1/2)*(Id+e2we3w e8we9),(1/2)*(Id+e2we4we6we8));\nSBgens[[9,0]]:=\n[Id,e2,e3,e4,e5,e6,e 7,e8,e9,e2we3,e2we4,e2we5,e2we6,e2we7,e2we8,e2we9];\nFBgens[[9,0]]:=[I d];\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+e 4we8),(1/2)*(Id+e5we9));\nSBgens[[5,4]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e 2we5,e3we4,e3we5,e4we5,e2we3we4, e2we3we5,e2we4we5,e3we4we5,e2we3we4we 5];\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+e2we 3we6we7),\n (1/2)*(Id+e2we3we8we9),(1/2)*(Id+e2we4we6we8));\n SBgens[[1,8]]:=[Id,e2,e3,e4,e5,e6,e7,e8,e9,e2we3,e2we4,e2we5,e2we6,e2w e7,e2we8,e2we9];\nFBgens[[1,8]]:=[Id];\nSBKgens[[1,8]]:=SBgens[[1,8]]; \n\n#Complex, semi-simple - none\n\n#Quaternionic, semi-simple (5 case s)\nprimidemp[[0,3]]:=(1/2)*(Id+e1we2we3);\nSBgens[[0,3]]:=[Id,e1,e2,e 3];\nFBgens[[0,3]]:=[Id,e1,e2,e1we2];\nSBKgens[[0,3]]:=[Id];\n\nprimid emp[[1,4]]:=\n''cmulQ''((1/2)*(Id+e2we3we4),(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,e 2we3,e2we4,e2we5];\nFBgens[[5,0]]:=[Id,e2we3,e3we5,e2we5];\nSBKgens[[5 ,0]]:=[Id,e2];\n\nprimidemp[[2,5]]:=\n''cmulQ''((1/2)*(Id+e3we4we5),(1 /2)*(Id+e1we6),(1/2)*(Id+e2we7));\nSBgens[[2,5]]:=[Id,e1,e2,e3,e4,e5,e 1we2,e1we3,e1we4,e1we5,\n e2we3,e2we4,e2we5,e1we2we3,e1 we2we4,e1we2we5];\nFBgens[[2,5]]:=[Id,e3,e3we5,e5];\nSBKgens[[2,5]]:=[ Id,e1,e2,e1we2];\n\nprimidemp[[6,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)* (Id+e2we3we4we5),(1/2)*(Id+e6we7));\nSBgens[[6,1]]:=[Id,e2,e3,e4,e5,e6 ,e2we3,e2we4,e2we5,e2we6,e3we6,\n e4we6,e5we6,e2we3we6 ,e2we4we6,e2we5we6];\nFBgens[[6,1]]:=[Id,e2we3,e3we5,e2we5];\nSBKgens[ [6,1]]:=[Id,e2,e6,e2we6];\n\nprimidemp[[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,e2 we5,e2we6,e2we7,\ne3we4,e3we5,e3we6,e3we7,e4we5,e4we6,e4we7,e2we3we4,e 2we3we5,e2we3we6,\ne2we3we7,e2we4we5,e2we4we6,e2we4we7,e3we4we5,e3we4w e6,e3we4we7,\ne2we3we4we5,e2we3we4we6,e2we3we4we7];\nFBgens[[7,2]]:=[I d,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+e2 we4),\n (1/2)*(Id+e3we5),(1/2)*(Id+e6we7we8we9));\nSBgens[[3, 6]]:=[Id,e2,e3,e6,e7,e8,e9,e2we3,e2we6,e2we7,e2we8,e2we9,e3we6,e3we7, \ne3we8,e3we9,e6we7,e6we8,e6we9,e2we3we6,e2we3we7,e2we3we8,e2we3we9,e2 we6we7,\ne2we6we8,e2we6we9,e3we6we7,e3we6we8,e3we6we9,e2we3we6we7,e2we 3we6we8,\ne2we3we6we9];\nFBgens[[3,6]]:=[Id,e6we7,e7we9,e6we9];\nSBKge ns[[3,6]]:=[Id,e2,e3,e6,e2we3,e2we6,e3we6,e2we3we6];\n\nreturn ([K,dim overK,struct,primidemp[[p,q]],\n SBgens[[p,q]],FBgens[[p,q]],SB Kgens[[p,q]]]);\nend proc:\n##################\nreturn clidata2(a1); # ### <<< Return from 'clidata'\nend proc: #### <<< End of 'clidata'\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 53. Procedure " }{TEXT 340 10 "Bs ignature" }{TEXT -1 313 " finds the signature of the form B assuming \+ that B is a diagonal matrix or a symmetric matrix. It returns a list L with two or three integers depending on whether B is non-degenerate o r 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 the diagonal form of B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 42 "Typical use : Bsignature(); Bsignature(B);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1286 "Bsignature:=proc() local curB,Bdiag,pos,neg,deg,i,L;global B;\no ptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: July 22, 2006`; \n#############################################\nif nargs=0 then\n \+ if not type(B,matrix) then\n error \"square matric should be ass igned to B first\"\n else curB:=B \n end if;\nelif nargs=1 then \n if not type(evalm(args[1]),matrix) then\n error \"argument entered is not a matrix\"\n else curB:=evalm(args[1]) \n end i f;\nelse error \"wrong number of arguments. See ?Bsignature for more h elp.\" \nend if;\nBdiag:=diagonalize(evalm(curB-(curB-linalg[transpose ](curB))/2));\nif not type(Bdiag,diagmatrix) then \n error \"unable \+ to diagonalize symmetric part of the input\"\nend if;\nL:=map(signum,[ seq(Bdiag[i,i],i=1..linalg[coldim](Bdiag))]):\nif not type(L,list(inte ger)) then\n error \"unable to determine signs of expressions %1\",L \nend if;\npos:=0:neg:=0:deg:=0:\nfor i from 1 to linalg[coldim](Bdiag ) do\nif L[i]<>0 then\n if 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 d o;\nif deg=0 then return [pos,neg] else return [pos,neg,deg] end if;\n end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 157 "No. 51. Spinor represen tation 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 minimal left or right ideal in Cl(Q) \+ generated by a primitive idempotent f. The procedure is invoked with \+ four arguments:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 " " {TEXT -1 69 "(1) the first argument is an algebraic expression of ty pe clipolynom;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 210 "(2) the second argument is a list of generators of the m inimal ideal S considered as a K-vector space. For standard f equal t o clidata()[4] these generators are stored under clidata()[6] for the \+ given form B; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 241 "(3) the third argument is a list of basis elements spann ing K. For standard f equal to clidata()[4] these generators are stor ed under clidata()[5]. Matrices computed by 'spinorKrepr' will be exp ressed in terms of these basis elements of K;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 111 "(4) the fourth argumen t is a one of the strings 'left' or 'right' depending whether the idea l is left or right." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 562 "When standard input is used, i.e., the second argum ent equals clidata()[7] and the third argument equals clidata()[5], th e procedure tries to use previously computed matrices representing 1-v ectors. These matrices are stored as .m files with the names 'matreal L.m', 'matcompL.m', 'matquatL.m' for real, complex, and quaternionic m atrices in the left-regular spinor representation. If the first argume nt entered belongs to Cl(Q) whose 1-vector matrices have been previous ly computed, the procedure calls 'matKrepr' which makes use of these p re-computed matrices." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 470 "Typical use: dim:=4:B:=linalg[diag](1,-1,-1,-1):c libasis:=cbasis(dim):data:=clidata():\n f:=dat a[4]:\n sbasis:=minimalideal(clibasis,f,'left' );\n fbasis:=Kfield(sbasis,f);\n \+ Kbasis:=spinorKbasis(sbasis[2],f,fbasis[2],'left');\n \+ spinorKrepr(e1,Kbasis[1],fbasis[2],'left');\n \+ spinorKrepr(2*e1+Id-3*e1we2we3,Kbasis[1],fbasis[2],'l eft');\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5595 "spinorKrepr:=proc(a1: :\{clibasmon,climon,clipolynom,numeric\},\n a2::list( \{clibasmon,climon,clipolynom\}),\n a3::list(\{clibas mon,climon,clipolynom\}),\n a4::\{string,symbol\})\nl ocal i,j,k,reprdim,r,a,FBgens,eq,hbasis,g,terms,sys,vars,sol,M,pqsig,p q,\n flag_left,data,Kbasis,f,v,pqmod8,n,expr,flag_simple;\nglobal B,_prolevel,_shortcut_in_spinorKrepr,matrealL,matrealR,matcompL,matco mpR,matquatL,matquatR;\noptions `Copyright (c) 1995-2006 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n########################################### ##\nif not type(B,diagmatrix) then \n error \"bilinear form B must b e defined as diagonal matrix\" \nelse pq:=Bsignature() \nend if;\n#### ##############################\nif pq[1]-pq[2]=1 mod 4 then flag_simpl e:=false else flag_simple:=true end if;\n############################# #####\nif maxindex(a1) > linalg[coldim](B) then\n error \"maximum in dex %1 found in input is greater than the size %2 of the current bilin ear form B\", maxindex(a1),linalg[coldim](B) \nend if;\n############## ####################\nhbasis:=a2:FBgens:=a3:reprdim:=nops(hbasis):n:=n ops(FBgens):\n##################################\nif member(a4,\{'left ',\"left\"\}) then flag_left:=true elif\n member(a4,\{'right',\"righ t\"\}) then flag_left:=false else\n error \"last argument expected t o be 'left' or 'right' but received %1 instead\",a4\nend if; \n####### #################################################################\n#Th is procedure gives faithful representations when Cl(p,q) is simple\n#a nd unfaithful when Cl(p,q) is semi-simple. In order to get faithful\n# representations in this last case, use 'matKrepr' or use this procedur e\n#as shown in examples.\n########################################### #############################\n#if flag_simple then\nif a1=Id then re turn linalg[diag](1$reprdim) elif\n a1=-Id then return linalg[diag]( -1$reprdim) elif\n type(a1,numeric) then return linalg[diag](a1$repr dim) \nend if;\n###################################################### ##################\n#when _shortcut_in_spinorKrepr is false, 'matKrepr ' is not used\n####################################################### #################\nif _shortcut_in_spinorKrepr then\n pqmod8:=(pq[1] -pq[2]) mod 8:\n if member(pqmod8,\{0,1,2\}) and flag_left then \n \+ #if not assigned(matrealL) then readlib(matrealL) end if;\n \+ pqsig:=map(op,[indices(matrealL)]) \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\}) and flag_left then \n #if not assigned(ma tcompL) then readlib(matcompL) end if;\n pqsig:=map(op,[indices( matcompL)]) \n elif member(pqmod8,\{3,7\}) and not flag_left then\n \+ #if not assigned(matcompR) then readlib(matcompR) end if;\n \+ pqsig:=map(op,[indices(matcompR)]) \n elif member(pqmod8,\{4,5,6\}) and flag_left then \n #if not assigned(matquatL) then readlib(ma tquatL) end if;\n pqsig:=map(op,[indices(matquatL)]) \n elif m ember(pqmod8,\{4,5,6\}) and not flag_left then\n #if not assigned (matquatR) then readlib(matquatR) end if;\n pqsig:=map(op,[indic es(matquatR)]) \n end if;\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 i f;\n end if;\nend if;\n#####################################\n#Co ntinue finding the matrix\n#####################################\na:=' a':j:='j':k:='k':\nif flag_left then\n expr:=add(add(a[j,k]*cmulQ(hb asis[j],FBgens[k]),j=1..reprdim),k=1..n);\n for j from 1 to reprdim \+ do r[j]:=add(a[j,k] * FBgens[k],k=1..n) end do; \n for i from 1 to reprdim do\n eq:=expand(cmulQ(a1,hbasis[i])-expr);\n term s:=cliterms(eq);\n eq:=clicollect(eq,terms);\n sys:=\{coef fs(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 \"una ble to find matrix due input 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](linalg[stackmatrix](seq(eval(v[i]),i=1..reprdim )));\nreturn subs(Id=1,evalm(M));\nelse \n expr:=add(add(a[j,k]* cmulQ(FBgens[k],hbasis[j]),j=1..reprdim),k=1..n);\n for j from 1 to \+ reprdim do r[j]:=add(a[j,k] * FBgens[k],k=1..n) end do; \n for i f rom 1 to reprdim do \n eq:=expand(cmulQ(hbasis[i],a1)-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 the n \nerror \"unable to find matrix due to input error: check if the las t argument matches the one previously used in 'spinorKbasis'\"\n \+ end if; \n v[i]:=convert([seq(subs(sol,r[j]),j=1..reprdim)],vec tor);\n end do:\n################################################### #########################\n#The next line produces wrong results in so me quat right cases:\n#M:=linalg[transpose](linalg[stackmatrix](seq(ev al(v[i]),i=1..reprdim)));\n########################################### #################################\nM:=linalg[stackmatrix](seq(eval(v[i ]),i=1..reprdim));\nreturn subs(Id=1,evalm(M));\nend if;\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 52. Procedure " }{TEXT 342 5 "rmulm" }{TEXT -1 110 " extends the following multiplications to matri x entries: cmul, cmulQ, wedge, omul, `&r`, `&*`\n " }} {PARA 258 "" 0 "" {TEXT -1 271 "In this last case, the commutative mul tiplication `*` is applied to the matrix entries. It takes three arg uments or four arguments. If the fourth argument is used, it is either of type name/symbol/array/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 "To apply Clifford multiplication 'cmul[B]' to matrix entries enter one of the following: " }}{PARA 258 "" 0 "" {TEXT -1 143 "rmulm(M1, M2, cmul); rmulm(M1,M2,cmul,B);rmulm(M1,M2,cmu l,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 Cliffor d multiplication 'cmulQ[B]' to matrix entries enter one of the followi ng:" }}{PARA 258 "" 0 "" {TEXT -1 235 "rmulm(M1, M2, cmulQ); rmulm(M1, M2,cmulQ,B);rmulm(M1,M2,cmulQ,K);rmulm(M1,M2,cmulQ,-K);\n&cQm(M1, M2); &cQm[B](M1,M2);&cQm[K](M1,M2);&cQm[-K](M1,M2); \n\nTo apply wedge m ultiplication 'wedge' to matrix entries enter one of the following:" } }{PARA 258 "" 0 "" {TEXT -1 60 "rmulm(M1, M2, `&w`); M1 &wm M2; r mulm(M1, M2, wedge); " }}{PARA 258 "" 0 "" {TEXT -1 113 "\nTo apply s ome generic possibly non-commutative multiplication `&r` to matrix ent ries enter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 37 "rmu lm(M1, M2, `&r`); M1 &rm M2; " }}{PARA 258 "" 0 "" {TEXT -1 98 " \nTo apply standard commutative scalar multiplication to matrix entrie s enter one of the following:" }}{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 quaternion ic entries we have as follows: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 89 "To apply quaternionic multiplication 'q mul' to matrix entries enter 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 + e2we3, e3 + e4, e1 - e2, Id + e1we3]); \n\nM1 := \+ linalg[matrix](2, 2, [Id + 2*qi + 3*qj, qi, qi + qj]); " }}{PARA 258 "" 0 "" {TEXT -1 58 "M2 := linalg[matrix](2, 2, [Id + qi, qj, qk, Id - qi]); \n" }}{PARA 258 "> " 0 "" {MPLTEXT 1 0 7267 "rmulm:=proc(a1:: \{list(matrix),dfmatrix,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,co B,nameB,lname,tail,out;\nglobal _prolevel, `&r`;\noptions `Copyright ( c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: July 22, 2006`;\n################# ############################\n################################\nif has (0,map(simplify,[a1,a2])) then return 0 end if;\n##################### ########### \nif nargs=3 then\n coB:=1:\n nameB:=`B`: \n lna me:=`B`: \nelif nargs=4 then\n if type(eval(args[4]),\{name,symbol, matrix,array\}) then\n coB:=1:\n nameB:=args[4];\n l name:=args[4];\n elif type(eval(args[4]),`&*`(numeric,\{name,symbol ,matrix,array\})) then\n coB:=op(select(type,\{op(args[4])\},num eric));\n nameB:=op(remove(type,\{op(args[4])\},numeric));\n \+ lname:=args[4]:\n else \n error \"wrong type of fourth arg ument %1 in rmulm\",args[4] \n end if;\nelse\n error \"three or f our arguments expected 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_prolev el:=false\nend if; \n################################\n if type(a1,matrix) and not type(a1,\{dfmatrix,climatrix,cliscalar\}) a nd \n type(a2,matrix) and not type(a2,\{dfmatrix,climatrix,cliscal ar\})\nthen \n _prolevel:=reset_prolevel:\n return evalm(a1 &* a2) \n end if;\n################################\nif type(a1,list(mat rix)) and type(a2,list(matrix)) then \n if nops(a1)<>nops(a2) then e rror \"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..nops(a1))]\n end if;\nend if;\n######################## ########\nif type(a1,dfmatrix) and type(a2,dfmatrix) then\n return c dfmatrix(procname(ddfmatrix(a1),ddfmatrix(a2),tail))\nend if;\n####### #########################\nif type(a1,\{clipolynom,cliscalar,clibasmon ,climon\}) then \n if type(a2,list(matrix)) then return (map2(procna me,args)) \n elif type(a2,dfmatrix) then \n return subs(Id=1, convert(map2(procname,a1,ddfmatrix(a2),tail),dfmatrix))\n end if\nen d if;\n################################\nif type(a2,\{clipolynom,clisc alar,clibasmon,climon\}) then \n if type(a1,list(matrix)) then retur n map(procname,args) \n elif type(a1,dfmatrix) then \n return subs(Id=1,convert(map(procname,ddfmatrix(a1),a2,tail),dfmatrix))\n \+ end if\nend if;\n################################\n#if not member(a3, \{`&*`,`&r`,Cliplus:-climul,cmul,cmulQ,wedge,qmul,Octonion:-omul\}) th en \n# error \"third argument must be one of the following: cmul, cm ulQ, wedge, qmul, omul, &*, &r but received %1 instead\",a3 #\n#end if ;\n################################\nif member(a3,\{`&*`\}) and \n ( type(a1,\{clibasmon,climon,clipolynom,climatrix\}) or\n type(a2,\{c libasmon,climon,clipolynom,climatrix\})) then\nerror \"it makes no sen se to apply commutative multiplication &* to non-commuting elements %1 and %2\",a1,a2 \nend if;\n################################\nar1:=eval m(a1):ar2:=evalm(a2):\nif not type(a1,matrix) and type(ar1,matrix) the n \n _prolevel:=reset_prolevel: \n return procname(ar1,a 2,tail) \nend if;\nif not type(a2,matrix) and type(ar2,matrix) then \n _prolevel:=reset_prolevel:\n return procname(a1,ar2,tail) \nend if;\n########################################################## ##########################\n##If both inputs are of type clipolynom, c limon, or clibasmon do the following:\n############################### #####################################################\nif (type(evalm( a1),\{clibasmon,climon,clipolynom\}) \n and \n type(evalm(a2),\{ clibasmon,climon,clipolynom\}))\nthen \n if member(a3,\{Cliplus:-cl imul,cmul,cmulQ\}) then\n _prolevel:=reset_prolevel: \n re turn simplify(reorder(a3[lname](a1,a2)))\n elif \n member(a3, \{wedge,qmul,omul\}) then\n _prolevel:=reset_prolevel:\n if \+ _warnings_flag and nargs=4 then\n WARNING(sprintf(\"ignoring f ourth argument %a\",lname))\n end if; \n #return simplif y(reorder(a3(a1,a2)))\n return eval('simplify'('reorder'(a3(a1,a2 ))));\n else\n _prolevel:=reset_prolevel: \n return simp lify(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),\{clibasm on,climon,clipolynom,cliscalar\}) \n and \n type(a2,matrix)\n th en \n if member(a3,\{qmul\}) then \n m2:=map(eval,a2) \n \+ else \n m2:=a2 \n end if;\n L:=map(displayid,convert(m 2,'mlist'));\n newL:=[]:\n for i from 1 to nops(L) do newL:=[op(ne wL),a3[lname](a1,L[i])] end do;\n if not member(a3,\{qmul\}) then\n \+ _prolevel:=reset_prolevel: \n return map(displayid,map(sim plify,linalg[matrix](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 polynomi al and a1 is a matrix\n#######################################\nif typ e(evalm(a2),\{clibasmon,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,convert(m1,'mlist'));\n newL:=[]:\nfor i from 1 to nops (L) do newL:=[op(newL),a3[lname](L[i],a2)] end do;\nif not member(a3, \{qmul\}) then\n _prolevel:=reset_prolevel:\n return map(simplify, linalg[matrix](linalg[rowdim](a1),linalg[coldim](a1),newL))\nelse\n \+ _prolevel:=reset_prolevel: \n return map(simplify,linalg[matrix](lin alg[rowdim](a1),linalg[coldim](a1),newL))\nend if:\nend if: \n######## ##############################################\n##If both inputs are o f type matrix, do the following:\n#################################### ##################\nif member(a3,\{qmul\}) then \n m1:=evalm(map(eval ,a1));m2:=evalm(map(eval,a2))\nelse \n m1:=evalm(a1);m2:=evalm(a2); \+ \nend if;\nm1:=displayid(m1):m2:=displayid(m2):\nr1:=linalg[rowdim](m1 ):r2:=linalg[rowdim](m2):\nc1:=linalg[coldim](m1):c2:=linalg[coldim](m 2):\nif c1 <> r2 then \n error \"matrices have incompatible dimensio ns and cannot be multiplied\" \nend if;\nM:=linalg[matrix](r1,c2,[]); \nk:='k':\nfor i from 1 to r1 do\nfor j from 1 to c2 do\nif a3=`&*` th en \n M[i,j]:=sum(m1[i,k] * m2[k,j],k=1..c1) \nelse \n M[i,j]:=map (simplify,add(a3[lname](m1[i,k],m2[k,j]),k=1..c1)) \nend if;\nod end d o;\n_prolevel:=reset_prolevel:\nif member(a3,\{Cliplus:-climul,cmul,cm ulQ,wedge\}) then \n return subs(Id=1,map(reorder,map(simplify,evalm (M)))) else\n return subs(Id=1,map(simplify,evalm(M))) \nend if;\nif not member(a3,\{`&*`,`&r`,Cliplus:-climul,cmul,cmulQ,wedge,qmul,Octon ion:-omul\}) then \n error \"third argument must be one of the follo wing: cmul, cmulQ, wedge, qmul, omul, &*, &r but received %1 instead\" ,a3 end if;\nreturn ;\nend proc:" }}{PARA 0 "" 0 "" {TEXT 261 9 "\nNo. 53: " }{TEXT 343 5 "`&cm`" }{TEXT 344 333 " denotes multiplication of matrices when Clifford product of Cl(B) is applied to matrix entries. One can use index as in &cm[K](p1,p2), &cm[-K](p1,p2), or &cm(p1,p2), &cm(M1,M2. However, when K has been assigned a matrix, put K between \+ double quotes as in &cm[''K''](p1,p2), &cm[''-K''](p1,p2).\n(Has been \+ moved to Clifford:-setup).\n " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 273 8 "No. 54: " }{TEXT 345 6 "`&cQm`" }{TEXT 346 416 " denotes multip lication of matrices when Clifford product of Cl(Q) is applied to matr ix entries. One can use index as in &cQm[K](p1,p2), or &cQm[-K](p1,p2) provided index has not been assigned a matrix. If K has been assigned a matrix, put K between double quotes as in &cQm[''K''](p1,p2), or &c Qm[''-K''](p1,p2). Procedure can also be used withouht the index as in &cQm(p1,p2).\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 274 8 "No. 55: " }{TEXT 347 5 "`&wm`" }{TEXT 348 131 " denotes multiplication of matrices when wedge/exterior produ ct is applied to matrix entries:\n(Has been moved to Clifford:-setup). \n" }}{PARA 0 "" 0 "" {TEXT 262 8 "No. 56: " }{TEXT 349 5 "`&qm`" } {TEXT 350 127 " denotes multiplication of matrices when quaternion pro duct is applied to matrix entries:\n(Has been moved to Clifford:-setup ).\n" }}{PARA 0 "" 0 "" {TEXT 275 8 "No. 57: " }{TEXT 351 5 "`&om`" } {TEXT 352 154 " denotes multiplication of matrices when non-associativ e octonionic multiplication is applied to the matrix entries.\n(Has be en moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT 263 8 "No. 58 : " }{TEXT 353 5 "`&rm`" }{TEXT 354 217 " denotes multiplication of ma trices when a generic associative but possibly not commutative `&r` pr oduct is applied to matrix entries. It can take index. User needs to d efine procedue `&r` in a similar mannet to `&c`." }{TEXT -1 1 "\n" } {TEXT 479 37 "(Has been moved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 59. Procedure " }{TEXT 355 8 "matKrepr" }{TEXT -1 261 " uses previously computed matrices of basis 1-vectors to find \+ a matrix representation in a minimal left or right ideal of any Cliffo rd polynomial in the given Clifford algebra Cl(Q). Depending on the s ignature [p,q] of the quadratic form Q, these matrices are " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 119 "real if (p - q) mod 8 is 0, 1, 2; \ncomplex if (p - q) mod 8 is 3 or 7; \nqua ternionic if (p - q) mod 8 is 4, 5, or 6." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 311 "The real matrices of 1-vecto rs in dimensions from 2 to 8 have been computed with the procedure 'sp inorKrepr' in minimal left ideals and stored in a form of a table call ed 'matrealL' in Maple library. The indices of the table are given by \+ the signature [p,q]. To see matrices in a specific signature [p,q], en ter" }}{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 "(assuming, of course, that the matrices for this s ignature are real)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 359 "Similarly for complex matrices in dimensions from 3 to 7 which are stored in the file 'matcompL.m' and for quaternionic m atrices in dimensions from 2 to 8 which are stored in the file 'matqua tL.m'.\n\nSimilarly for matrices representing basis 1-vectors in right minimal ideals; in this case corresponding files are: 'matrealR.m', ' matcompR.m', and 'matquatR.m'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 316 "Matrices representing Clifford polynom ials are generally computed with 'matKrepr' much faster than with 'spi norKrepr' because the former is a linear procedure that uses matrix mu ltiplication '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 "T ypical use: " }}{PARA 258 "" 0 "" {TEXT -1 92 "to see matrices represe nting 1-vectors in a left minimal ideal for the current form B enter: " }}{PARA 258 "" 0 "" {TEXT -1 12 ">matKrepr();" }}{PARA 258 "" 0 "" {TEXT -1 4 " " }}{PARA 258 "" 0 "" {TEXT -1 103 "to find a matrix r epresenting a Clifford polynomial p for the current B in a left minima l ideal enter:\n" }}{PARA 258 "" 0 "" {TEXT -1 36 ">matKrepr(p); \n>ma tKrepr(p,'left');\n" }}{PARA 0 "" 0 "" {TEXT 256 313 "to find a matrix representing a Clifford polynomial p for the current B in a right min imal ideal enter:\n\n>matKrepr(p,'right');\n\nto see matrices represen ting 1-vectors in a minimal left or right ideal when Q has the signatu re [p,q], enter:\n\n>matKrepr([p,q]);\n>matKrepr([p,q],'left');\n\nor \n\n>matKrepr([p,q],'right');" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4863 "matKrepr:=proc() \nlocal mindex,B size,dim,ind,pq,pqsig,matdata,i,a1,a2,dimrepr,ans,pqmod8,pqmod4,matdat atable,\n m,flag_simple,k,L,t,co,x,reprmulm;\nglobal B,matrealL,m atcompL,matquatL,matrealR,matcompR,matquatR:\noptions `Copyright (c) 1 995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: July 22, 2006`;\n##################### ########################\n#Checking argument types\nif not member(narg s,\{0,1,2\}) then \n error \"wrong number of arguments: expects 0, 1 , or 2 argument(s)\" \nend if;\nif member(nargs,\{1,2\}) and not type( args[1],\{list,clibasmon,climon,clipolynom\}) then\n error \"first a rgument must be of type 'list', clibasmon, climon, or clipolynom but r eceived one of type %1\",whattype(args[1]) \nend if;\nif nargs=2 and \+ not member(args[2],\{'left','right'\}) then \n error \"second argume nt, when used, must be 'left' or 'right', but received %1\",args[2] \+ \nend if;\nif nargs<>0 then a1:=args[1] end if;\nif nargs=0 or type(a1 ,\{clibasmon,climon,clipolynom\}) then\n if not type(B,matrix) then \+ \n error \"matrix must be assigned to B\"\n elif not type(B,' diagmatrix') then\n error \"bilinear form B must be diagonal\"\n else \n pq:=Bsignature();\n pqmod8:=(pq[1]-pq[2]) mod \+ 8;\n pqmod4:=(pq[1]-pq[2]) mod 4;\n flag_simple:=evalb(pqm od4<>1);\n end if;\nelif type(a1,list) then pq:=a1:pqmod8:=(pq[1]-p q[2]) mod 8 \nelse error \"wrong argument(s)\"\nend if;\n############# #################################\nif type(a1,\{clibasmon,climon,clipo lynom\}) then\n mindex:=maxindex(a1):Bsize:=linalg[coldim](B):\n i f mindex > Bsize then\n error \"input error: maximum index in you r input %1 is greater than the size %2 of the currently defined biline ar form B\",mindex,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 fi le: \nif member(pqmod8,\{0,1,2\}) then\n if a2='left' then \n \+ #if not assigned(matrealL) then readlib(matrealL) end if;\n \+ matdatatable:=matrealL:\n else\n #if not assigned(mat realR) then readlib(matrealR) end if;\n matdatatable:=matreal R:\n end if;\nelif member(pqmod8,\{3,7\}) then\n if a2='left ' then\n #if not assigned(matcompL) then readlib(matcompL) en d if;\n matdatatable:=matcompL:\n else \n #if not assigned(matcompR) then readlib(matcompR) end if;\n matdatat able:=matcompR:\n end if;\nelif member(pqmod8, \{4,5,6\}) then\n \+ if a2='left' then\n #if not assigned(matquatL) then readl ib(matquatL) end if;\n matdatatable:=matquatL:\n else\n \+ #if not assigned(matquatR) then readlib(matquatR) end if;\n \+ matdatatable:=matquatR:\n end if; \n else error \"wrong va lue of pqmod8: %1\",pqmod8 \nend if;\n################################ #######\npqsig:=map(op,[indices(matdatatable)]);\nif not member(pq,pqs ig) then\n error \"matrices for signature %1 in %2 minimal ideal hav e not been computed yet\",pq,a2 \nend if;\n########################## #############\nmatdata:=matdatatable[pq]:\nif nargs=0 or type(a1,list) then \n return matdata\nend if;\n#Continue if the first element is \+ a polynomial\ndim:=linalg[coldim](B):dimrepr:=linalg[coldim](rhs(matda ta[1]));\nif dim<>nops(matdata) then \n error \"size of B is differe nt from the number of 1-matrices\"\nend if;\n######################### ###############\nreprmulm:=proc() \n if nargs=1 then return args \n \+ elif nargs=2 then return subs(Id=1,rmulm(args,`cmulQ`)) \n else re turn subs(Id=1,reprmulm(args[1..(nargs-2)],rmulm(args[nargs-1],args[na rgs],`cmulQ`))) \n end if;\nend proc:\n############################ ############\nm:=array(1..nops(matdata)):\nfor i from 1 to nops(matdat a) do m[i]:=rhs(matdata[i]) end do;\nif type(a1,clibasmon) then\n in d:=Clifford:-extract(a1,'integers'): \n if a1='Id' then \n if f lag_simple then \n return linalg[diag](1$dimrepr) \n else \n return convert([linalg[diag](1$dimrepr)$2],'dfmatrix') \+ \n end if;\n end if; \n if nops(ind)=1 then ind:=op(ind):\n return subs(Id=1,evalm(m[ind])) \n else return subs(Id=1,rep rmulm(seq(evalm(m[ind[i]]),i=1..nops(ind)))) \n end if:\nend if;\n## #######################################\nans:=clilinear(a1,'K'):\nif f lag_simple then \n return subs(Id=1,evalm(eval(subs(K=procname,ans)) )) \nend if;\nans:=eval(subs(K=procname,ans));\nif type(ans,`+`) then \+ ans:=[op(ans)] elif\n type(ans,`*`) then ans:=[ans] else\n error \+ \"unexpected type in matKrepr\" \nend if;\nL:=select(type,ans,matrix); \nans:=remove(type,ans,matrix);\nk:='k':x:='x':\nfor t in ans do\n \+ m:=ddfmatrix(op(select(type,[op(t)],matrix)));\n co:=mul(x,x=remove (type,[op(t)],matrix));\n L:=[op(L),convert([seq(evalm(co*m[k]),k=1 ..2)],'dfmatrix')]\nend do:\nif nops(L)=1 then return L[1] end if;\nan s:=L[1]:\nfor k from 2 to nops(L) do\nans:=adfmatrix(ans,L[k]) end do: \nreturn evalm(ans);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 25 "No . 60. Sorting function " }{TEXT 376 7 "bygrade" }{TEXT -1 789 ": it so rts a list of Clifford basis monomials, Clifford monomials, or Cliffor d polynomials. Basis monomials and Clifford monomials are sorted by gr ade; in case of a tie it sorts by lexicographic order based on the bas is monomials. However, basis monomials are put before Clifford monomia ls. If any of the elements is a Clifford polynomial, then ties are res olved by sorting by the weight of each element (defined as the sum of \+ the grades of all terms) and then by then number of Clifford basis mon omials in each expression. It returns true or false in each case, and \+ can be used in sorting a list of basis monomials, Clifford monomials, \+ and Clifford polynomials in the construction sort(L, bygrade).\n\nUse: bygrade(p1,p2) where p1 and p2 are of type 'clibasmon', 'climon', or \+ 'clipolynom';\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1982 "bygrade:=proc( a1::\{clibasmon,climon,clipolynom\},\n a2::\{clibasmon,cl imon,clipolynom\}) \nlocal flag1,flag2,flag11,flag22,p1,p2,n1,n2,c1,c2 ,x,w1,w2;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Be rtfried Fauser. All rights reserved.`;\ndescription `Last revised: Jul y 22, 2006`;\n#############################################\nif type(a 1,clibasmon) then p1:=a1;\n flag1:=true:\n \+ flag11:=true:\n n1: =Clifford:-extract(p1): \n elif type(a1,climon) then p1:=op(cliterm s(a1));\n flag1:=true:\n \+ flag11:=false:\n n1:=Clifford:-extrac t(p1): \n else p1:=a1;\n flag1:=false:\nend if;\nif type(a2,c libasmon) then p2:=a2;\n flag2:=true:\n \+ flag22:=true:\n n2:=Cl ifford:-extract(p2): \n elif type(a2,climon) then p2:=op(cliterms(a 2));\n flag2:=true:\n \+ flag22:=false:\n n2:=Clifford:-extract(p 2): \n else p2:=a2;\n flag2:=false:\nend if;\nx:='x':\nif fla g1 and flag2 then\n if nops(n1)nops(n2) then return false\n else \n if evalb(flag11 an d flag22) then return lexorder(p1,p2)\n elif evalb(flag11 and \+ not flag22) then return lexorder(p1,p2)\n elif evalb(not flag1 1 and flag22) then return not lexorder(p2,p1);\n else return t rue\n end if;\n end if; \nelse \n n1:=maxgrade(p1):\n c1: =cliterms(p1):\n w1:=add(maxgrade(x),x=c1):\n n2:=maxgrade(p2):\n \+ c2:=cliterms(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 2118 "commutingelements:=proc( a1::list(clibasmon)) \nlocal g,groupgens,L,L2,numfact,f,flag1,flag2,fl ag3,gen,p,q,i;\nglobal B;\noptions `Copyright (c) 1995-2006 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: July 22, 2006`;\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 bi linear form B is not diagonal as expected\" \nend if;\np:=Bsignature(B )[1]:q:=Bsignature(B)[2]:\nnumfact:=q-RHnumber(q-p):\nflag1:=member(Id ,a1):\nL:=remove(member,a1,[Id]):\n#return a1 if it was [Id]\nif L=[] \+ then return args end if; \n#return a1 if had one element of square 1 o r [] if the square <>1 \nif nops(L)=1 then\n if cmul(L[1],L[1])=Id t hen return L\n else return [] \nend if;\nend if;\n#First, sort th e list\nL:=sort(L,bygrade):\n#Find first element of square 1 mod Id\nf lag2:=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 groupgen s \n end if;\nend if; \nif nops(groupgens)=numfact then \n return \+ (sort(groupgens,bygrade)) end if;\n#Find commuting elements with squar e 1 mod Id in the specified list of basis monomials\nfor g in L while \+ nops(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 1733 "factoridempotent:=proc(a1::idempotent) \nlocal T,ee ,i,L,flag,flag1,flag2,b1b2,b1,b2,ans;\nglobal B;\noptions `Copyright ( c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: July 22, 2006`;\n################# ############################\nif a1=Id then return Id end if;\nif not \+ type(B,matrix) then \n error \"matrix must be assigned to B\"\nend i f;\nif not type(B,'diagmatrix') then \n error \"the bilinear form B \+ is not diagonal as expected\" \nend if;\nee:=eval(a1):\nL:=sort(remove (member,convert(cliterms(ee),list),[Id]),bygrade):\nif nops(L)=1 then \+ \n ans:=(1/2)*(Id+L[1]);\n if displayid(a1-ans)=0 then return ans \+ else return a1 end if;\nend if;\nflag1:=true:\nwhile flag1 do\nflag2:= true:\nL:=sort(L,bygrade);\nfor b1 in L while flag2 do\nfor b2 in remo ve(member,L,[b1]) while flag2 do\n b1b2:=cmulQ(b1,b2):\n if memb er(b1b2,L) then flag2:=false;\n L:=remove(me mber,L,[b1b2]) end if;\n if member(-b1b2,L) then flag2:=false;\n \+ L:=remove(member,L,[-b1b2]) end if;\n if fl ag2 then flag1:=false end if;\nod od end do: \nL:=commutingelements(L) ;\nif nops(L)=1 then \n ans:=(1/2)*(Id+L[1]);\n if displayid(a1-an s)=0 then return ans else return a1 end if;\nend if;\nL:=sort(L,bygrad e);\ni:='i':\nans:='cmulQ'(seq((1/2)*(Id+L[i]),i=1..nops(L)));\nif eva l(ans)-a1=0 then return (ans) end if;\n#try another sign permutation\n for i from 1 to nops(L) do\n L||i:=[L[i],-L[i]]\nend do:\nT:=combin at[cartprod]([seq(L||i,i=1..nops(L))]):\nflag:=false:\nwhile not T[fin ished] and not flag do \nL:=T[nextvalue]();\nans:='cmulQ'(seq((1/2)*(I d+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 799 "m akealiases:=proc(a1::posint,a2::\{symbol,string\}) \nlocal L,i,k,l,K,s ;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`,remember;\ndescription `Last revised: Ju ly 22, 2006`;\n#############################################\nif not a 1>1 then \n error \"first parameter must be a positive integer large r than one\" \nend if;\nif nargs=2 and not member(a2,\{'ordered',\"ord ered\"\}) then\n error \"second optional parameter, when used, must \+ be 'ordered'\" \nend if;\nk:='k':l:='l':i:='i':\nL:=[seq(op(combinat[c hoose]([seq(i,i=1..a1)],k)),k=2..a1)];\nif nargs=1 then \n K:=[seq(o p(combinat[permute](l)),l=L)];\n s:=seq(cat(e,op(K[i]))=makeclibasmo n(K[i]),i=1..nops(K))\nelse\n s:=seq(cat(e,op(L[i]))=makeclibasmon(L [i]),i=1..nops(L))\nend if;\nreturn 'alias'(s)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 64. Procedure " }{TEXT 380 4 "cinv" } {TEXT -1 1285 " calculates a symbolic inverse of any Clifford polynomi al p in the given Clifford algebra Cl(B) or in its subalgebra. The pr ocedure determines a basis for the smallest subalgebra of Cl(B) in whi ch the inverse might exist. For example, if the polynomial p contains 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\nIf \+ 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 then \+ not every element in Cl(B) has the inverse. For example, nilpotent an d non-trivial idempotent elements have no inverses. Elements p such t hat p &c p = a*p for some 'cliscalar' also have no inverses (these el ements are called here 'almost idempotent').\n\nThus, if B is assigned 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 error m essage. Otherwise it returns 'NULL'.\n\nThis procedure can be used wi th a second optional argument K of type symbol, name, matrix , or arra y. In that case, it computes the inverse in Cl(K). The seconf argument can also be -K, or any numeric multiple of K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 70 "Typical use: cinv(e1 + \+ 2*e2);cinv(e1 + 2*e2,K); cinv(e1 + 2*e2,-K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4196 "cinv:=proc(a1::\{cliscalar,clibasmon,climon,clipoly nom\}) \nlocal p,pp,pinv,mindex,cinv11,s,aaa,flagB,flagBdiag,S,lname,f lagindexed;\nglobal B,_warnings_flag;\noptions `Copyright (c) 1995-200 6 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: July 22, 2006`;\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:\n else error \"only one or two arguments are expected\"\nend if;\n###### ######################\ncinv11:=proc(a1,lname)\nlocal i,d,dbasis,N,u,x m,v,uv,vu,vars,sys,L1,v1,nontrivial;\nglobal evenelement;\n nontrivi al:=proc(S::\{set(\{relation,algebraic\}),list(\{relation,algebraic\}) \}) \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 remove(i strivial,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:=clico llect(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[lname]( v,u)-Id,dbasis);\nvars:=\{coeffs(v,dbasis)\};\nsys:=\{coeffs(uv,dbasis ),coeffs(vu,dbasis)\};\nsys:=nontrivial(sys); #eliminate trivial equat ions\nL1:=solve(sys,vars);\nif L1=NULL then return (NULL) else \nv1:=s ubs(L1,v);\nv1:=reorder(v1):\nv1:=clicollect(v1):\nv1:=map(normal,v1); \nreturn (eval(v1)): \nend if;\nend proc:\n########################### ##########\nif type(a1,cliscalar) then\n if a1<>0 then return 1/a1 e lse error \"0 has no inverse\" end if;\nend if;\nmindex:=maxindex(a1); \nif mindex=0 then return Id/scalarpart(a1) end if;\np:=simplify(reord er(a1)):\np:=displayid(p):\npinv:=cinv11(p,lname);\nif evalb(pinv<>NUL L) then return pinv end if; \n#####################################\nf lagB:=type(evalm(lname),matrix):\nif not flagB then return \"unable to find inverse of %1\",a1 end if;\n#################################### #\nif _warnings_flag then\n WARNING(`testing why entered argument ha s no inverse...`)\nend if;\n#Checking these special cases only when ln ame is assigned a matrix:\ns:='s':aaa:='aaa':\nflagBdiag:=type(evalm(l name),diagmatrix):\n#######################################\n###Checki ng if element a1 is nilpotent\n####################################### \nif type([p,lname],nilpotent) then\n if flagBdiag then \n erro r \"element %1 is nilpotent in signature %2 and as such it has no inve rse\",a1,Bsignature(lname) \n else\n error \"element %1 is nilp otent in current %2 and as such it has no inverse\",a1,lname \n end \+ if;\nend if;\n#######################################\n###Checking if \+ element a1 is idempotent\n#######################################\nif \+ not member(p,\{Id\}) and type([p,lname],idempotent) then\n if flagBd iag then \nerror \"element %1 is an idempotent in signature %2 and as \+ such it has no inverse\",a1,Bsignature(lname)\n else \nerror \"eleme nt %1 is an idempotent in current %2 and as such it has no inverse\",a 1,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 almost 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 err or \"element 'p'=%1 is almost an idempotent since %2 and as such it ha s no inverse in current %3\", a1,subs(s,'cmul'('p','p')=aaa*'p'),lname \n end if;\nend if;\n#######################################\nS:=\{s olve(pp-s*p,s)\}:\nif not evalb(S=\{\}) then \n if flagBdiag then \n error \"element 'p'=%1 is almost an idempotent since %2 and as such it has no inverse in signature %3\", a1,subs(aaa=op(S),'cmul'('p','p' )=aaa*'p'),Bsignature(lname)\n else \n error \"element 'p'=%1 is a lmost an idempotent since %2 and as such it has no inverse in current \", a1,subs(aaa=op(S),'cmul'('p','p')=aaa*'p'),lname\n end if;\nend \+ if;\nreturn NULL\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 65 . Procedure " }{TEXT 381 9 "pseudodet" }{TEXT -1 87 " computes pseudod eterminant 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 "T ypical use: M := linalg[matrix](2, 2, [Id, e1 + e2, e3, e4we3]); " } }{PARA 258 "" 0 "" {TEXT -1 37 " pseudodet(M); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 529 "pseudodet:=proc(a1::\{climatrix,matrix\}) local M,a,b,c,d;\noptio ns `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n## ###########################################\nM:=map(displayid,evalm(a1 )):\nif linalg[rowdim](M) <> 2 or linalg[coldim](M) <> 2 then \n err or \"matrix must be 2 x 2\" \nend if;\na:=simplify(M[1,1]): b:=simpli fy(M[1,2]):\nc:=simplify(M[2,1]): d:=simplify(M[2,2]):\nreturn simpli fy(cmul(a,reversion(d)) - cmul(b,reversion(c)))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 45 "No. 66. Defining quaternionic mutliplication \+ " }{TEXT 382 4 "qmul" }{TEXT -1 687 ". Quaternions are defined as the even elements in Cl(3) (or the para-bivectors in Cl(3)). Thus, a quat ernion basis is [Id, e3we2,e1we3,e2we1] and it is available as the fir st component of global variable '_quatbasis' defined at the initializa tion time (type _quatbasis or _quatbasis[1] at the Maple prompt to see it). See P. Lounesto, \"Clifford Algebras and Spinors\", page 49, fo r more information on quaternions. Any element that belongs to this v ector space is now of type 'quaternion'. The infix form of this multip lication is `&q`. Via the procedure 'rmulm', the quaternionic multip lication may also be applied to matrices with quaternionic entries and is then denoted by `&qm`." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 121 "NOTE: in order to see answers displayed in t erms of the basis \{Id, qi, qj, qk\}, apply 'qdisplay' to the result o f 'qmul'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 105 "Typical use: qmul(Id + e1we2, e1we3); or (Id + 2*e1we2) &q (e2we3 + e1we2); or (Id + qi) &q (qj + qk); \n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 1295 "qmul:=proc() local q1,q2,q3,step1,repqmul; \n \+ global B,qi,qj,qk,_default_Clifford_product;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. Al l rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n#### #########################################\nif member(0,[args]) then re turn 0 end if;\nif nargs=1 then return qdisplay(args) end if;\n repq mul:=proc() \n if nargs=1 then return args elif\n nargs=2 t hen return 'qmul'(args) else\n return repqmul(args[1..(nargs-2) ],'qmul'(args[nargs-1],args[nargs])) \n end if;\n end proc:\nif \+ nargs>2 then \n q3:=eval(repqmul(args)):\n return qdisplay(map(com bine,q3,trig)) \nend if;\n_default_Clifford_product:='cmulNUM':\nq1:=e val(args[1]):q2:=eval(args[2]):\nif type(q1,`^`) or type(q2,`^`) then \+ \n error \"illegal expression found: use 'qinv' for the quaternionic inverse\" \nend if;\nif type(q1,cliscalar) or type(q2,cliscalar) then \n return qdisplay(q1*q2) \nend if;\nif q1=Id then return qdisplay( q2) end if;\nif q2=Id then return qdisplay(q1) end if;\nif not type(q1 ,quaternion) or not type(q2,quaternion) then\n error \"wrong input t ype: input must be of type 'cliscalar' or 'quaternion'\" \nend if;\nst ep1:=reorder(cmul(q1,q2));\nreturn qdisplay(map(combine,clicollect(ste p1),trig))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 375 23 "No. 67. Amper sand form " }{TEXT 383 4 "`&q`" }{TEXT 384 4 " of " }{TEXT 385 4 "qmul " }{TEXT 386 39 ".\n(Has been moved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 42 "No. 68. Defining quaternionic conjugation " } {TEXT 387 8 "q_conjug" }{TEXT -1 112 ". Recall that complex conjugati on was named 'c_conjug' while the Clifford conjugation was just 'conju gation'. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 68 "Typical use: q_conjug(Id + 2*e1we2); or q_conjug(Id + 2*q i + qk); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 554 "q_conjug:=proc(q:: algebraic) local q1; global qi,qj,qk;\noptions `Copyright (c) 1995-200 6 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: July 22, 2006`;\n############################ #################\nif type(q,matrix) then return map(procname,q) elif \n type(q,\{cliscalar,quaternion\}) then\nq1:=eval(q):\nif type(q1,c liscalar) then return q1 \nelse\n return qdisplay(2*scalarpart(q1)- q1)\nend if;\nelse\n error \"wrong input types: input must be of typ e 'cliscalar', 'quaternion', or 'matrix' \" \nend if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 26 "No. 69. Quaternionic norm " }{TEXT 388 5 "qnorm" }{TEXT -1 24 " is defined as follows: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 65 " Typical use: qnorm(Id \+ + 2*e1we2); or qnorm(Id + qi + qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 443 "qnorm:=proc(q::\{cliscal ar,quaternion\}) local q1,n,co; global qi,qj,qk;\noptions `Copyright ( c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: July 22, 2006`;\n################# ############################\nq1:=expand(eval(q));\nif type(q1,cliscal ar) then return abs(q1) \nelse\n n:=0:for co in [coeffs(q1,cliterms( q1))] do n:=n+co^2 end do;\n return combine(sqrt(n),trig) \nend if; \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 38 "No. 70. Quaternionic i nverse is named " }{TEXT 389 4 "qinv" }{TEXT -1 141 ". Recall that th e inverse of a Clifford polynomial can be calculated with 'cinv' and t hat quaternions form a noncommutative division ring. " }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 66 "Typical use: qin v(Id + 2*e1we2); or qinv(Id + 2*qi + 3*qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 453 "qinv:=proc(q::\{cl iscalar,quaternion\}) local q1,q2; \noptions `Copyright (c) 1995-2006 \+ by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndesc ription `Last revised: July 22, 2006`;\n############################## ###############\nq1:=eval(q):\nif q1=0 then error \"zero quaternion ha s no inverse\"\nelif type(q1,cliscalar) and q1<>0 then return 1/q1\nel se q2:=q_conjug(q1)/(qnorm(q1))^2:\n return qdisplay(map(combine,q 2,trig))\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 7 1. Procedure " }{TEXT 390 8 "qdisplay" }{TEXT -1 101 " displays quater nions or matrices with quaternionic entries in terms of the basis \{Id , qi, qj, qk\}. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 " " {TEXT 360 93 "Typical use: qdisplay(e1we2 + 2*Id); map(qdisplay, mat rix(2, 2, [Id, e1we2, e2we3, e1we3])); " }{TEXT -1 2 " \n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 719 "qdisplay:=proc(a1::\{algebraic,array\}) loc al q; global qi,qj,qk;\noptions `Copyright (c) 1995-2006 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n########################################### ##\nif type(a1,matrix) then\n if not type(a1,climatrix) then \n \+ return evalm(a1) else \n return map(qdisplay,a1) \n end if;\ne nd if;\nq:=eval(simplify(a1)):\nif type(q,cliscalar) then return q end if;\nif type(q,quaternion) then\nq:=map(combine,clicollect(reorder(q) ),trig);\nreturn coeff(q,Id)-coeff(q,e1we2)*'qk'+coeff(q,e1we3)*'qj'-c oeff(q,e2we3)*'qi'\nelse \nerror \"wrong input type: input must be of \+ type 'cliscalar', 'quaternion', or 'matrix' \" \nend if;\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 72. Procedure " }{TEXT 391 5 "r ot3d" }{TEXT -1 161 " rotates a vector in 3-dimensional Euclidean spac e V using the quaternion multiplication. Namely, any vector v is tra nsformed 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 q uaternion given in the basis [Id, e1we2, e1we3, e2we3]. The first entr y should be a vector (or any element of the Clifford algebra) while th e second element is a quaternion. Type '_quatbasis' to see how quater nions are defined here. Elements 'qi', 'qj', '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 := li nalg[diag](1$3); \n" }}{PARA 258 "" 0 "" {TEXT -1 108 "before using ' rot3d'. Of course, 'rot3d' will also work if the first argument were \+ any element in Cl(3). \n" }}{PARA 258 "" 0 "" {TEXT -1 296 "NOTE: tra ditionally one uses \{1, i, j, k\} to denote a quaternion basis. Here , we are using symbol 'qi' for 'i', 'qj' for 'j', and 'qk' for 'k'. S ymbol 'Id' denotes, as usual, the unit element in all Clifford algebra s as well as the unit element in reals, complexes, quaternions, and oc tonions. " }}{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 853 " rot3d:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ a2::quaternion) \nlocal q2,q2inv; global B,qi,qj,qk; \noptions `Copy right (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`;\ndescription `Last revised: July 22, 2006`;\n########## ###################################\nif not assigned(B) or not type(B, matrix) then \n error \"bilinear form B has not been assigned yet. I t must be defined as the identity 3 x 3 matrix.\"\nend if:\nif not lin alg[equal](B,linalg[diag](1$3)) then \n error \"the identity 3 x 3 m atrix must be assigned to B\" \nend if;\nif nargs <> 2 then \n error \"two arguments needed of type algebraic and quaternion\" \nend if; \+ \nq2:=clisort(map(combine,eval(a2),trig)); \nq2inv:=clisort(map(combin e,eval(qinv(eval(q2))),trig)); \nreturn clicollect(clisort(map(combine ,cmulQ(q2,a1,q2inv),trig))) \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 73. Procedure " }{TEXT 392 9 "isproduct" }{TEXT -1 238 " ca n determine whether the given Clifford polynomial, e.g. p := Id + 4*e 1we2 + 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 witho ut any option as follows:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 12 "Typical use:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "isproduct(p); answers \+ true or false;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 151 "isproduct(p, 'any'); answers true or false, and gives a list of n vectors [v1, v2, ..., vn] such that the 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 fals e, and gives a list of general vectors [v1, v2, ..., vn] such that the Clifford product v1 &c v2 &c ... &c vn = p;\n\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 4891 "isproduct:=proc(p::\{cliscalar,clibasmon,climon,c lipolynom\},\n s::\{string,symbol\}) \nlocal M,maxg,T,c o,vv,x,cf,pnew,p1,L,v,j,S,S2,i,v1v2,expr,t,sys,\nvars,sol,ventries,fla g,flagB,flagtB,param,flagsol,eq,P1,P2,die,parvalues;\nglobal _MaxSols, B;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2 006`;\n#############################################\nif not member(na rgs,\{1,2\}) then\n error \"one or two arguments needed of type 'clisc alar', 'clibasmon', 'climon', 'clipolynom', and 'symbol'\"\nend if;\ni f nargs=2 and not member(s,\{'all','any'\}) then\n error \"second (o ptional) argument must be 'all' or 'any'\"\nend if;\nif not type(B,dia gmatrix) then \n error \"diagonal 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 flag do\n if B[i,i]<>0 then flag :=true;\n return [true,[(scalarpart(p)/B[i,i])*e||i,e||i]] \n end if;\n end do;\nerror \"none of the basis 1-vectors has a \+ square equal to 1 or -1\" \nend if;\n################################# ####################\n#Any 1-vector is already factored:\n############ #########################################\nif 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:=f actor(reorder(displayid(p))):\nflagtB:=evalb(type(p1,\{clibasmon,climo n\}) and flagB):\nif flagtB then \n S:=op(Clifford:-extract(p1,'i ntegers'));\n if nargs=1 then return true else \n v:=[e||S]; \n if not remove(hastype,p1,clibasmon)=NULL\n then v[1]: =remove(hastype,p1,clibasmon)*v[1] \n end if;\n return [true ,v] \n end if; \nend if;\n##################################### ####################\n#If p does not belong to any of the special case s above,\n#find common indices to all monomial terms in p, if any,\n#a nd then simplify p by factoring out the common factors:\n############# ############################################\nT:=cliterms(p):\nco:=`in tersect`(op(map(convert,map(Clifford:-extract,T,'integers'),set)));\nx :='x':\nif nops(co)<>0 then\n co:=sort(convert(co,list));\n vv:=[s eq(cat(e,x),x=co)];\n cf:=cmul(op(vv));\n pnew:=cmul(p,cf,cf,cf); \n if nargs=1 then M:=procname(pnew) \n elif\n nargs=2 the n L:=procname(pnew,s);\n M:=[L[1],[op(L[2]),op(vv)]] ; \n end if;\n return M\nend if; \n############################## #######################\n#This is the most general case when no common indices\n#in monomial terms are found:\n############################# ########################\nS2:=map(Clifford:-extract,cliterms(p),'integ ers');\nS:=\{op(map(op,S2))\}; \nv:=table([]):\nfor j from 1 to maxg d o\nv[j]:=0:\nfor i in S do v[j]:=v[j]+cat(x,j,i)*cat(e,i) \nend do;\ne nd do;\nv1v2:=cmul(seq(v[j],j=1..maxg));\nexpr:=clicollect(simplify(re order(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(in dets(sys))],lexorder); \n_MaxSols:=1: #setting maximum number of sol utions to one\nvars:=convert(vars,set):\nsol:=[solve(sys,vars)]:\nif n ops(sol)=0 then return false end if;\nventries:=[seq(v[j],j=1..maxg)]; \n#######################################################\n#Finally, w e need to return result in appropriate form.\n#By now, if p were not f actorable, 'false' should have\n#been returned:\n##################### ##################################\nif nargs=1 then return true end if ; \nif nargs=2 and s='all' then return [true,subs(sol[1],ventries)] en d if; \n#########################################################\n#If the second parameter is 'any', assign random values\n#to the paramete rs showing up in the answer. These random\n#values will change with ea ch 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\n S2:=\{\}: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 un ion \{lhs(eq)=parvalues[die()]\};\n end if;\nend do;\nP2:=remove(para m,S2):\nL:=map(op,subs(P2,ventries));\nif not member(0,subs(P1,map(den om,L))) then flagsol:=true end if;\nend do:\nif flagsol then return [t rue,subs(P1,subs(P2,ventries))]\n else return [true,subs(sol [1],ventries)]\nend if;\nend if;\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 74. 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 counte r-examples\", in eds. R. Ablamowicz, P. Lounesto, and J. Parra, `Clif ford algebras with symbolic and numeric computations`, Birkhauser, Bos ton, 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 elemen ts in Cl(p, q), then the following conditions must be met:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "1. a, b, c, d are products of vectors;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 74 "2. the pseudodeterminant of V is +1 or -1 (or Id or -Id in the algebra);" }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 98 "3. a &c reversion(b), reversion(b) \+ &c d, d &c reversion(c), and reversion(c) &c a are all vectors." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 31 "Typic al 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 example of Vahlen matrix is due to Johannes \+ Maks)." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1209 "isVahlenmatrix:=proc(cm::\{matrix,climatrix\}) \nlocal expr1 ,expr2,a,b,c,d,m; global B;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: July 22, 2006`;\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 b e 2 x 2\" \nend if;\nm:=displayid(cm):\na:=simplify(m[1,1]):b:=simplif y(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 then if not isproduct(b) then return false fi end if;\nif c<>0 then if not isproduct(c) then return false fi end if;\ni f d<>0 then if not isproduct(d) then return false fi end if;\n######## ##################################\n### Condition 2:\n################ ##########################\nif not member(pseudodet(m),\{1,-1,Id,-Id\} ) then return false end if;\n######################################### #\n### Condition 3:\n##########################################\n" } {TEXT 359 0 "" }{MPLTEXT 1 0 585 "expr1:=simplify(cmul(a,reversion(b)) );\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(simplify(expr1 -expr2)=0) then return false end if;\nexpr1:=simplify(cmul(reversion(b ),d));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(simplify(e xpr1-expr2)=0) then return false end if;\nexpr1:=simplify(cmul(d,rever sion(c)));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(simpli fy(expr1-expr2)=0) then return false end if;\nexpr1:=simplify(cmul(rev ersion(c),a));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(si mplify(expr1-expr2)=0) then return false end if;\nreturn true\nend pro c:" }}{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 minimal 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 linear ly independent, k=1..(n-1) where n = degree of the minimal polynomial \+ of p. If the second optional argument is 'horner' then polynomial is r eturned 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 clim inpoly(p,'s');" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1403 "climinpoly:=proc(p::\{cliscalar,clibasmon,climon,cl ipolynom\})\nlocal dp,L,flag,pp,expr,a,k,eq,sys,vars,sol,poly,lname;\n options `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: July 22, 2006` ;\n#############################################\nif type(op(procname) ,procedure) then\n lname:=`B`;\n else\n lname:=op(procname);\ne nd if;\ndp:=displayid(p):\nif maxgrade(dp)=0 then L:=[Id] else L:=[Id, dp] end if;\nflag:=false:k:='k':a:='a':\nwhile not flag do\npp:=cmul[l name](L[nops(L)],dp):\nexpr:=expand(add(a[k]*L[k],k=1..nops(L)));\neq: =clicollect(pp-expr);\nsys:=\{coeffs(eq,cliterms(eq))\};\nvars:=\{seq( a[k],k=1..nops(L))\};\nsol:=solve(sys,vars):\nif sol<>NULL then flag:= true else L:=[op(L),pp] end if;\nend do;\npoly:='x'^nops(L)-add(a[k]*' x'^(k-1),k=1..nops(L));\npoly:=sort(subs(sol,poly)); \nif nargs=1 then return poly\nelif nargs=2 then\n if args[2]='powers' then return \+ [poly,L]\n elif args[2]='horner' then return convert(poly,horner )\n else error \"second (optional) argument must be 'powers' or \+ 'horner' \"\n end if;\nelif nargs=3 then\n if member(args[2], \{'powers','horner'\}) and\n member(args[3],\{'powers','horner' \}) then\n return ([convert(poly,horner),L])\n else e rror \"wrong arguments\"\n end if;\nelse error \"wrong number of a rguments: one, two, 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 poly nomial p into any polynomial pol in one variable. It may be used with \+ an optional third argument in which case it returns unevaluated polyno mial 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 "satisfies its own minimal polynomial." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 197 "Typical use: subs_clim inpoly(p,pol);\n subs_climinpoly(p,pol, 'horner'); \n subs_climinpoly(p,pol, \"horner\");\n \+ subs_climinpoly(p,pol, horner);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1329 "subs_clipolynom:=proc(clinumber::\{symbol,cliscalar ,clibasmon,climon,clipolynom\},\n minpoly::poly nom,o::\{symbol,string\}) \nlocal ph,d,k,r,q,h,expr,s,var,varx,dclinum ber;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n#############################################\nph:=convert(mi npoly,horner);\nvar:=op(remove(type,indets(ph),indexed));\nif not type (eval(clinumber),\{clibasmon,climon,clipolynom\}) \n then return sub s(var=clinumber,ph) \nend if;\nif nops(\{var\})<>1 then varx:=op(selec t((member,\{var\},\{x,y,z\}))) else varx:=var end if;\nif nops(\{varx \})<>1 then \n error \"expecting only one of x, y, or z as a variabl e 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]:=conve rt(s,horner);\nh:=q[k];\nend do:\ndclinumber:=displayid(clinumber):\ne xpr:=clicollect(r[d]*Id+q[d]*dclinumber);\nfor k from d-1 to 1 by -1 d o\n expr:=r[k]*Id+'cmul'(expr,dclinumber);\nend do:\nif nargs=2 the n return simplify(eval(expr))\nelif nargs=3 then \n if args[3]='horn er' then return expr \n else \n error \"third (optional) arg ument, when used, must be 'horner', but received %1 instead\",args[3] \n end if;\nelse error \"wrong number of arguments\"\nend if;\nend p roc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 77. Procedure " }{TEXT 396 4 "sexp" }{TEXT -1 427 " finds a power series expansion of a Cliff ord polynomial p up to and including order n modulo the minimal polyno mial of p. It is recommended that this procedure be used when n > d, w here d is the degree of the minimal polynomial of p. Otherwise, use 'c exp' or 'cexpQ' instead. The reason is that 'sexp' is faster than 'cex p' when n > d, but is is slower when n <= d. This procedure can use an optional argument such as K or -K." }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 49 "Typical use: sexp(p,4); sexp(p,4,K) ;sexp(p,4,-K);" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1522 "sexp:=proc(p::\{numeric,cliscalar,clibasmon,climon, clipolynom\},n::nonnegint) \nlocal k,pp,pol,powrs,co,te,nte,lname,coB, nameB;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: July 2 2, 2006`;\n#############################################\nif nargs=2 t hen\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \nelif nargs=3 the n\n if type(args[3],\{name,symbol,matrix,array\}) then\n coB: =1:\n nameB:=args[3];\n lname:=args[3];\n elif type(arg s[3],`&*`(numeric,\{name,symbol,matrix,array\})) then\n coB:=op( select(type,\{op(args[3])\},numeric));\n nameB:=op(remove(type, \{op(args[3])\},numeric));\n lname:=args[3]:\n else \n \+ error \"wrong type of third argument in sexp. See ?sexp for more help. \" \n end if;\nelse\n error \"two or three arguments expected in s exp. See ?sexp for more help.\"\nend if;\n############################ #########\nif n=0 then \n if type(p,\{numeric,'cliscalar'\}) then re turn 1 else return Id fi\nend if;\nk:='k':\nif type(p,\{numeric,clisca lar\}) then 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(t e):\nfor k from 1 to nte do \n te[k]:=powrs[degree(te[k],'x')+1] \n end do;\nreturn clicollect(add(co[k]*te[k],k=1..nte))\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 358 18 "No. 78. Procedure " }{TEXT 397 8 "all_si gs" }{TEXT 398 383 " gives signatures of all real, real simple, real s emi-simple, complex, quaternionic, quaternionic simple, and quaternion ic semi_simple Clifford algebras up to and including the dimension spe cified as the first parameter. Second parameter, when used, must be 'r eal', '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 2803 "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,semis imple_q_pq;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: J uly 22, 2006`;\n#############################################\nif narg s=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\nWA RNING(`try first argument as range, e.g., 1..9, second argument as 're al', 'complex', or 'quat', and third arguments as 'simple' or 'semisim ple' 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 366 "adfmatrix:=proc(M1::dfmatrix , M2::dfmatrix) local L1, L2;\noptions `Copyright (c) 1995-2006 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: July 22, 2006`;\n#################################### #########\n L1:=ddfmatrix(M1);\n L2:=ddfmatrix(M2);\n return \+ cdfmatrix(evalm(L1[1] + L2[1]), evalm(L1[2] + L2[2]))\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 361 22 "No. 80/81: Procedures " } {TEXT 403 9 "beta_plus" }{TEXT 404 5 " and " }{TEXT 401 10 "beta_minus " }{TEXT 402 374 " [originally procedure 'beta' from the package 'doub le'] are now part of \"CLIFFORD\". They give two scalar bilinear forms in the spinor ideal S of Cl(Q).\n\nUsage: beta_plus(psi,phi,f); beta_ plus(psi,phi,f),'s'); beta_minus(psi,phi,f); beta_minus(psi,phi,f),'s' ); where psi and phi are spinors, f is an idempotent, and 's' is an op tional argument that will store 'purescalar'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2001 "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,_prole vel;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n#############################################\nif not _prolev el then\n if not type(psi,\{cliscalar,clibasmon,climon,clipolynom\}) t hen \n error \"first argument must be of type 'cliscalar', 'clibasmon ', 'climon', or 'clipolynom'\" \n end if;\n if not type(phi,\{cliscala r,clibasmon,climon,clipolynom\}) then \n error \"second argument must be of type 'cliscalar', 'clibasmon', 'climon', or 'clipolynom'\" \n e nd if;\nend if;\n###Load in pre-computed data and check if idempotents are the same\nlocdata:=clidata(B):\nlocf:=eval(locdata[4]);\nKbas:=lo cdata[6];\nif nops(Kbas)>1 then\n flagf:=evalb(f=eval(locf) or f=gra deinv(locf) or \n f=-gradeinv(locf) or f=-eval(locf)); \n if not flagf then\nerror \"when K = C or K = H, primitive idempot ent f = plus/minus clidata(B)[4] or its grade involution\"\n end if; \nend if;\n###\n y:=cmul(reversion(expand(psi)),expand(phi));\n \+ if y = 0 then return 0 end if;\n m := 'm';i:='i':\n flag := fals e;\n mons := cbasis(linalg[coldim](B));\n v := array(1 .. nops(K bas),[]);\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, cli terms(eq))\};\n vars := \{seq(v[i], i = 1 .. nops(Kbas))\};\n \+ sol := solve(sys, vars);\n flag := not evalb(sol = NULL) \n end do:\n if nargs = 4 then\n if not type(args[4],name) or type(args[4],protected) then \n error \"fourth optional a rgument, when used, must be of type unprotected name\"\n else as sign(args[4],uu) \n end if;\n end if;\n lambda:=subs(sol,l ambda):\n if vectorpart(lambda,0)=lambda then return (scalarpart(la mbda)) \n else return lambda\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2033 "beta_minus:= proc(psi,phi,f) \nlocal lo cf,locdata,y,m,flag,mons,uu,eq,lambda,sys,sol,Kbas,v,i,vars,flagf;\ngl obal B,_prolevel;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: July 22, 2006`;\n#############################################\ni f not _prolevel then\n if not type(psi,\{cliscalar,clibasmon,climon,cl ipolynom\}) then \n error \"first argument must be of type 'cliscalar ', 'clibasmon', 'climon', or 'clipolynom'\" \n end if;\n if not type(p hi,\{cliscalar,clibasmon,climon,clipolynom\}) then \n error \"second a rgument must be of type 'cliscalar', 'clibasmon', 'climon', or 'clipol ynom'\" \n end if;\nend if;\n###Load in pre-computed data and check if idempotents are the same\nlocdata := clidata(B):\nlocf := eval(locdat a[4]);\nKbas := locdata[6];\nif nops(Kbas)>1 then\n flagf:=evalb(f=e val(locf) or f=gradeinv(locf) or \n f=-gradeinv(locf) o r 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 its grade i nvolution\"\n end if;\nend if;\n###\n y := cmul(conjugation(expan d(psi)),expand(phi));\n if y = 0 then return 0 end if;\n m := 'm ';i:='i':\n flag := false;\n mons := cbasis(linalg[coldim](B)); \n v := array(1 .. nops(Kbas),[]);\n lambda := add(v[i]*Kbas[i], i=1..nops(Kbas));\n for m in mons while not flag do\n uu := \+ m;\n eq := clicollect(cmul(m,y) - expand(cmul(lambda,f)));\n \+ sys := \{coeffs(eq, cliterms(eq))\};\n vars := \{seq(v[i], i = 1 .. nops(Kbas))\};\n sol := solve(sys, vars);\n fl ag := not evalb(sol = NULL)\n end do:\n if nargs = 4 then\n \+ if not type(args[4],name) or type(args[4],protected) then \n \+ error \"fourth optional argument, when used, must be of type unprote cted name\"\n else assign(args[4],uu) \n end if;\n \+ end if;\n lambda:=subs(sol,lambda):\n if vectorpart(lambda,0)=l ambda then \n return scalarpart(lambda) \n else \n retu rn lambda\n end if;\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 362 18 "N o. 82. Procedure " }{TEXT 405 9 "cdfmatrix" }{TEXT 406 100 " creates a matrix over double field from a list of two matrices or from a serque nce of to matrices.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 918 "cdfmatrix :=proc() local l1,l2,L,i,j,m,n,m1,m2,MN;\noptions `Copyright (c) 1995- 2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: July 22, 2006`;\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(arg s[2])\nelse error \"wrong number or types of arguments. 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 end 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 457 "ddfmatrix:=proc(M::dfmatrix) local m,n,i,L1,L2, L;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2 006`;\n#############################################\n m:=linalg[ro wdim](M);\n n:=linalg[coldim](M);\n L:=convert(M,mlist);\n L1 :=[seq(L[i][1],i=1..nops(L))];\n L2:=[seq(L[i][2],i=1..nops(L))];\n return [linalg[matrix](m,n,L1),linalg[matrix](m,n,L2)]\nend proc: \n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 364 18 "No. 84. Procedure \+ " }{TEXT 409 11 "diagonalize" }{TEXT 410 42 " tries to diagonalize a s ymmetric matrix.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 781 "diagonalize: =proc(m::symmatrix) local locB,flag,i,j,L,v,S,Bdiag;\noptions `Copyrig ht (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: July 22, 2006`;\n############# ################################\nif linalg[coldim](m)<>linalg[rowdim] (m) then\n error \"expected a square matrix as input\" \nend if;\nif type(m,diagmatrix) then \n return evalm(m) \nend if; \nL:=[linalg[e igenvects](m)];\nflag:=true:\nfor i from 1 to nops(L) while flag=true \+ do\n if L[i][2]>nops(L[i][3]) then flag:=false end if: \nend do: \n if not flag then \n error \"since matrix entered does not have a com plete set of linearly independent eigenvectors, it is not diagonalizab le\" \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 over a double field.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 362 "mdfmatrix:=proc(M1::dfmatrix,M2::d fmatrix) local L1, L2;\noptions `Copyright (c) 1995-2006 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n########################################### ##\n L1:=ddfmatrix(M1);\n L2:=ddfmatrix(M2);\n return cdfmatr ix((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 are the first two argumen ts of type 'clibasmon', 'climon', or 'clipolynom'. \n\nIf only two arg uments are passed to the procedure, element x belongs to the Clifford \+ algebra over the lowest dimension dim = max(maxindex(a1),maxindex(a2)) . \n\nIf three arguments are used with the third argument being a lis t of elements of type 'clibasmon', 'climon', or 'clipolynom', then x b elongs to the set generated by a1, a2, and the elements in the third l ist 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 ca se the procedure searches for x from that list.\n\nTypical use:\n\ncoc ycle(1+2*e1-e1we3,3*e2+e2we4);\ncocycle(1+2*e1-e1we3,3*e2+e2we4, [e1we 2+Id,e1we2we3,e4]);\ncocycle(1+2*e1-e1we3,3*e2+e2we4, [e1we2,e1we2we3, e4],'clibasmon');\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1468 "cocycle:=p roc(a1::\{clibasmon,climon,clipolynom\},\n a2::\{clibasmo n,climon,clipolynom\},\n a3::list(\{clibasmon,climon,clip olynom\}),\n a4::symbol) \nlocal g,v,n,llist,i,d,S,x,y,xy ,sys,vars,sol,llist1,llist2,llist3;\noptions `Copyright (c) 1995-2006 \+ by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndesc ription `Last revised: July 22, 2006`;\n############################## ###############\n#if a1=a2 then return [Id] end if;\nif nargs=4 and me mber(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,l list[i]):\n if x-y =0 then\n if x <> 0 and y <> 0 then\n \+ if cmul(llist[i],llist[i]) <> 0 then\n S:=[op(S),llist[i] ] :\n end if: \n end if: \n end if:\n end do:\nreturn S \nend if;\nif nargs=3 then\n llist1:=`union`(op(map(cliterms,remove(m ember,\{seq(op(\{cmul(a1,g),cmul(g,a1)\}),g=a3)\},\{0\})))):\n llist2 :=`union`(op(map(cliterms,remove(member,\{seq(op(\{cmul(a2,g),cmul(g,a 2)\}),g=a3)\},\{0\})))):\n llist3:=map(op@cliterms,convert(a3,set)); \+ \n llist:=convert(`union`(llist1,llist2,llist3),list):\n llist:=sor t([op(llist),op(cliterms(op(a3)))],bygrade):\nelse\n llist:=cbasis(ma x(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);\nclisolve(eq,set);\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 589 "clisolve:=proc(eq::\{clibasmon,climon,clipoly nom\},indet::\{list,algebraic\}) \nlocal i,T,vars,sol,sys;\noptions `C opyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`;\ndescription `Last revised: July 22, 2006`;\n####### ######################################\nif type(indet,list) then\n va rs:=convert(indet,set)\nelse\n vars:=select(type,indets(indet),indexe d)\nend if;\nT:=cliterms(eq);\nsys:=\{coeffs(clicollect(simplify(eq)), T)\};\nsol:=[solve(sys,vars)];\nif type(indet,list) then\n return sol \nelse\n return [seq(subs(sol[i],indet),i=1..nops(sol))]\nend if;\nen d proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 88. This procedure " } {TEXT 372 13 "CLIFFORD_ENV " }{TEXT 417 135 " lists all environnmental variables defined in Clifford, Cliplus, GTP, Octonion, and Bigebra pa ckages, when these packages are loaded.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6575 "CLIFFORD_ENV:=proc() global _warnings_flag:\noption s `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. A ll rights reserved.`;\ndescription `Last revised: July 22, 2006`;\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 pr int('``');###Print blank line\n lprint(`>>> Global variables defined i n Clifford:-setup are now available and have these values: <<<`);\nlpr int(`************* Start *************`); \n########################\n lprint('dim_V'=dim_V);\n #(dimension of the carrier space for Cl(V ,B))\nif not member(dim_V,\{1,2,3,4,5,6,7,8,9\}) and _warnings_flag th en\n lprint(`Warning, value of dim_V is expected to be a positive in teger between 1 and 9, inclusive.`);\n print('``');###Print blank li ne\nend if;\n########################\nlprint('_default_Clifford_produ ct'=_default_Clifford_product);\n #(controls whether cmulRS or cm ulNUM is used in Clifford product 'cmul')\n#lprint(`Possible values ar e: 'cmulRS','cmulNUM','cmulgen','cmul_user_defined'.`);\nif not member (_default_Clifford_product,\{'cmulRS','cmulNUM','cmulgen','cmul_user_d efined'\}) \n and _warnings_flag then\n lprint(`****** SERIOUS WAR NING ******`); \n lprint(`>>> Value of _default_Clifford_product was expected to be 'cmulRS', 'cmulNUM', 'cmulgen', or 'cmul_user_defined' . <<<`);\n lprint(`*****************************`);\nend if;\n###### ##################\nlprint('_prolevel'=_prolevel);\n #(controls w hether or not parsing is done)\nif not member(_prolevel,\{true,false\} ) and _warnings_flag then\n lprint(`Warning, value of _prolevel is e xpected to be true or false.`);\n print('``');###Print blank line\ne nd if;\n########################\nlprint('_shortcut_in_minimalideal'=_ shortcut_in_minimalideal);\n #(controls flow in procedure 'minima lideal')\nif not member(_shortcut_in_minimalideal,\{true,false\}) and \+ _warnings_flag then\n lprint(`Warning, value of _shortcut_in_minimal ideal is expected to be true or false.`);\n print('``');###Print bla nk line\nend if;\n########################\nlprint('_shortcut_in_Kfiel d'=_shortcut_in_Kfield);\n #(controls flow in procedure 'Kfield') \nif not member(_shortcut_in_Kfield,\{true,false\}) and _warnings_flag then\n lprint(`Warning, value of _shortcut_in_Kfield is expected to be true or false.`);\n print('``');###Print blank line\nend if;\n## ######################\nlprint('_shortcut_in_spinorKbasis'=_shortcut_i n_spinorKbasis);\n #(controls flow in procedure 'spinorKbasis')\n if not member(_shortcut_in_spinorKbasis,\{true,false\}) and _warnings_ flag then\n lprint(`Warning, value of _shortcut_in_spinorKbasis is e xpected to be true or false.`);\n print('``');###Print blank line\ne nd if;\n########################\nlprint('_shortcut_in_spinorKrepr'=_s hortcut_in_spinorKrepr);\n #(controls flow in procedure 'spinorKr epr')\nif not member(_shortcut_in_spinorKrepr,\{true,false\}) and _war nings_flag then\n lprint(`Warning, value of _shortcut_in_spinorKrepr is expected to be true or false.`);\n print('``');###Print blank li ne\nend if;\n########################\nlprint('_warnings_flag'=_warnin gs_flag);\n #(controls whether some procedures, e.g., 'wedge', gi ve warnings)\nif not member(_warnings_flag,\{true,false\}) then\n lp rint(`Warning, value of _warnings_flag is expected to be true or false .`);\n print('``');###Print blank line\nend if;\n################### #####\nlprint('_scalartypes'=_scalartypes);\n #(defines types con sidered to be 'scalars' by 'clibilinear' and 'clilinear')\n########### #############\nlprint('_quatbasis'=_quatbasis);\n #(defines defau lt quaternionic basis')\nlprint(`************* End *************`);\np rint('``');###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 hav e these values: <<<`);\n lprint(`************* Start *************`); \n lprint('macro(cmul=climul)');\n #('cmul' is now extended by 'c limul') \n lprint('macro(cmulQ=climul)');\n #('cmulQ' is now exte nded 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 'clirev')\n lprint('macro(LC=LCbi g)');\n #('LC' is now extended by 'LCbig')\n lprint('macro(RC=RCb ig)');\n #('RC' is now extended by 'RCbig')\n if _warnings_flag t hen \n lprint(`Warning, new definitions for type/climon and type/c lipolynom now include &C`);\n end if;\n lprint(`************* End **** *********`);\n print('``');###Print blank line \nend if;\n\n########## ##########################################\n### Executable Bigebra fil e for Maple 6 is Bigebra6\n########################################### #########\nif assigned(Bigebra6) then\n print('``');###Print blank lin e\n lprint(`>>> Global variables defined in Bigebra:-init are now avai lable and have these values: <<<`);\n lprint(`************* Start *** **********`);\n lprint('_CLIENV[_SILENT]'=_CLIENV[_SILENT]); #control s messaging upon starting 'Bigebra'\n lprint('_CLIENV[_QDEF_PREFACTOR] '=_CLIENV[_QDEF_PREFACTOR]); #prefactor in 'switch'\n lprint(`******* ****** End *************`);\n print('``');###Print blank line\nend if; \n##########################################\nif assigned(GTP) then\n \+ print('``');###Print blank line\n lprint(`************* 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 ava ilable and have these values: <<<`);\n print('``');###Print blank lin e\n lprint(`************* Start *************`); \n lprint('_octbasis '=_octbasis); #standard octonion basis as Maple global variab le\n lprint('_pureoctbasis'=_pureoctbasis); #pure octonion basis as M aple global variable\n lprint('_default_Fano_triples'=_default_Fano_tr iples); #default list of Fano triples\n lprint('_default_squares'=_def ault_squares); #default squares of e1,e2,e3,e4,e5,e6,e7\n lprint('_def ault_Clifford_product'=_default_Clifford_product); #selects cmulNUM fo r numeric B\n lprint(`************* End *************`);\n print('``') ;###Print blank line \nend if;\n###################################### ####\n\nreturn NULL\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 373 18 "No. \+ 89. Procedure " }{TEXT 418 13 "makeclibasmon" }{TEXT 419 402 " that ta kes a list and makes Grassmann basis monomials. It is expected, that t he list contains positive integers between 1 and 9 inclusive, or symbo lic indices consisting of one-character strings. If the list is empty, then Id is returned. If any two elements in the list are peated, then 0 is returned. This procedure has a remember table.\n\nTypical use: m akeclibasmon([]); makeclibasmon([1,7,i,j,3]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 470 "makeclibasmon:=proc(x::list) \nlocal result,N,i;\nop tions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`,remember;\ndescription `Last revised: July 22 , 2006`;\n#############################################\n N:=nops(x); \n if N = 0 then return Id end if;\n if N > nops(convert(x,set)) the n return 0 end if;\n result:=cat(e,x[1]);\n for i from 2 to N do \n result:=cat(result,cat(we,x[i]));\n end do:\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 Grassma nn basis monomial. It can be used without any arguments in which case \+ default values are used internally, or with 1 or 2 arguments as follow s:\n\nNT1 = maximum allowed index value (default 9)\nNT2 = maximum all owed grade (default 4)\n\nrd_clibasmon(); then NT1 = 9, NT2 = 4 \nrd_clibasmon(a1); then NT1 = a1, NT2 = 4\nrd_clibasmon(a 1,a2); then NT1 = a1, NT2 = a2\n\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1400 "rd_clibasmon:=proc() local ind,NT1,NT2,nt1d,nt2d,L;\noptions ` Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n###### #######################################\n### NT1 = maximum allowed ind ex value (default 9)\n### NT2 = maximum allowed grade (default 4) (mus t be less than or equal to NT1)\nnt1d,nt2d:=9,4:\n#################### #########################\nif nargs=0 then\n NT1,NT2:=nt1d,rand(0..n t2d)(): #defaults\n L:=[[]]:\nelif nargs=1 then\n if not type(args [1],nonnegint) or not evalb(args[1]<=9 and args[1]>= 0) then\n er ror \"argument must be non negative integer between 0 and 9 giving the maximum monomial index\"\n end if;\n NT1,NT2:=args[1],rand(0..arg s[1])():\n L:=[[]]: \n elif 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 negative integer between 0 and 9 giving m aximum monomial index. Second argument must be non negative integer be tween 0 and first argument giving maximum possible grade. Other argume nts, 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))];\nind:=sort(L[rand(1..nops(L))()]);\nretu rn Clifford:-makeclibasmon(ind)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 91. Procedure " }{TEXT 475 9 "rd_climon" }{TEXT -1 560 " ge nerates a random Grassmann monomial. It can be used without any argume nts in which case default values are used internally, or with 1, 2, or 3 arguments as follows:\n\nNT1 = maximum allowed index value (default 9)\nNT2 = maximum allowed grade (default 4)\nNT3 = maximum absolute v alue of coefficients allowed (default 12)\n\nrd_climon(); \+ then NT1 = 9, NT2 = 4, NT3 = 12 \nrd_climon(a1); then \+ NT1 = a1, NT2 = 4, NT3 = 12\nrd_climon(a1,a2); then NT1 = a1, N T2 = a2, NT3 = 12\nrd_climon(a1,a2,a3); then NT1 = a1, NT2 = a2, NT3 = a3\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1989 "rd_climon:=proc() loca l rcf,NT1,NT2,NT3,nt1d,nt2d,nt3d;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescri ption `Last revised: July 22, 2006`;\n################################ #############\n### NT1 = maximum allowed index value (default 9)\n### \+ NT2 = maximum allowed grade (default 4)\n### NT3 = maximum absolute va lue of coefficient allowed (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 th en\n if not type(args[1],nonnegint) or not evalb(args[1]<=9 and args [1]>= 0) then\n error \"argument must be non negative integer bet ween 0 and 9 giving the maximum monomial index\"\n end if;\n NT1,N T2,NT3:=args[1],rand(0..args[1])(),rand(1..nt3d)(); \nelif nargs=2 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.\"\n end if;\n NT1,NT2,NT3:=args[1],min(args[ 1],args[2]),rand(1..nt3d)():\nelif nargs>=3 then\n if evalb(not type ([args],list(nonnegint)) or \n not 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. T hird argument must be a positive integer giving max value of coefficie nt. Other arguments, if present, are ignored.\"\n end if;\n NT1,NT 2,NT3:=args[1],min(args[1],args[2]),args[3]:\nend if:\n#############\n rcf:=[rand(-NT3..-1)(),rand(1..NT3)()]:\nrcf:=rcf[rand(1..nops(rcf))() ];\nreturn rcf*rd_clibasmon(NT1,NT2)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 92. Procedure " }{TEXT 476 13 "rd_clipolynom" }{TEXT -1 761 " generates a random Grassmann polynomial. It can be used witho ut any arguments in which case default values are used internally, or \+ with 1, 2, 3, or 4 arguments as follows:\n\nNT1 = maximum allowed inde x value (default 9)\nNT2 = maximum allowed grade (default 4)\nNT3 = ma ximum absolute value of coefficients allowed (default 12)\nNT4 = maxi mum number of terms allowed (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_clip olynom(a1,a2); then NT1 = a1, NT2 = a2, NT3 = 12, NT4 = 4 \nrd_clipolynoma1,a2,a3); then NT1 = a1, NT2 = a2, NT3 = a3, NT 4 = 4\nrd_clipolynom(a1,a2,a3,a4); then NT1 = a1, NT2 = a2, NT3 = a3 , NT4 = a4\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3532 "rd_clipolynom:=pr oc() \nlocal rnt,rcf,NT1,nt1d,NT2,nt2d,NT3,nt3d,NT4,nt4d,L,newL,i,inde ,x,m;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: July 22 , 2006`;\n#############################################\n### NT1 = max imum allowed index value (default 9)\n### NT2 = maximum allowed grade \+ (default 4) (must be leq. than NT1)\n### NT3 = maximum absolute value \+ of coefficient allowed (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)(): #defa ults\nelif nargs=1 then\n if not type(args[1],nonnegint) or not eval b(args[1]<=9 and args[1]>= 0) then\n error \"argument must be non negative integer between 0 and 9 giving the maximum monomial index\" \n end if;\n NT1,NT2,NT3,NT4:=args[1],rand(0..args[1])(),\n \+ rand(1..nt3d)(),rand(1..nt4d)():\nelif nargs=2 then\nif e valb(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 a rgs[2]>=0)) then\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 poss ible grade.\"\n end if;\n NT1,NT2,NT3,NT4:=args[1],rand(0..min(arg s[1],args[2]))(),\n rand(1..nt3d)(),rand(1..nt4d)() : \nelif nargs=3 then\n if evalb(not type([args],list(nonnegint)) o r \n not evalb(args[1]<=9 and args[1]>=0) or\n n ot evalb(args[2]<=args[1] and args[2]>=0)) then\nerror \"first argumen t must be non negative integer between 0 and 9 giving maximum monomial index. Second argument must be non negative integer between 0 and fir st argument giving maximum possible grade. Third argument must be a po sitive 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 ty pe([args],list(nonnegint)) or \n not evalb(args[1]<=9 and a rgs[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 maximum monomial index. Second argument NT2 must be no n negative integer between 0 and NT1 (inclusive) giving maximum possib le grade. Third argument NT3 must be a positive integer giving max val ue of coefficient. Fourth argument NT4 must be a positive integer givi ng maximum number of terms (it is expected to be no larger that number of combinations NT1 choose NT2. Other arguments, if present, are igno red.\"\n end if:\n NT1,NT2,NT3,NT4:=args[1],min(args[1],args[2]),a rgs[3],args[4]:\nend if:\n#############\n### NT1 = maximum allowed ind ex value (default 9)\n### NT2 = maximum allowed grade (default 5)\n### NT3 = maximum absolute value of coefficient allowed (default 12)\n### NT4 = maximum number 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[rand(1..2)()]:\nfor i from 1 to m do\n inde:=ran d(1..nops(L))();\n x:=L[inde];\n newL:=[op(newL),x];\n L:=sub sop(inde=NULL,L);\nend do;\nL:=map(makeclibasmon,newL);\nrcf:=[rand(-N T3..-1)(),rand(1..NT3)()]:\nreturn add(rcf[rand(1..nops(rcf))()]*L[i], i=1..nops(L))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 33 "No. 93. I nitialization procedure " }{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 sessio n when command with(Clifford); is given." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1629 "setup:=proc() \nlocal x,y, i,j;\nglobal libname,B,\n_quatbasis,qi,qj,qk,\n_prolevel,\n_shortcut_i n_minimalideal,\n_shortcut_in_Kfield,\n_shortcut_in_spinorKbasis,\n_sh ortcut_in_spinorKrepr,\ndim_V,\n_warnings_flag,\n_scalartypes,\n_CLIEN V,\n_default_Clifford_product,\npause,\n############################## #####\n`convert/dfmatrix`,`convert/mlist`,`convert/str_to_int`,`type/c libasmon`,\n`type/antisymmatrix`,`type/climatrix`,`type/climon`,`type/ clipolynom`,\n`type/cliprod`,`type/cliscalar`,`type/dfmatrix`,`type/di agmatrix`, `type/evenelement`,`type/fieldelement`,`type/gencomplex`,`t ype/genquatbasis`,\n`type/genquaternion`,`type/idempotent`,`type/nilpo tent`,`type/oddelement`,\n`type/primitiveidemp`,`type/purequatbasis`,` type/quaternion`,\n`type/symmatrix`,`type/tensorprod`,\n`&c`,`&cQ`,`&c Qm`,`&cm`,`&om`,`&q`,`&qm`,`&rm`,`&w`,`&wm`;\n######################## ###########\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: J uly 22, 2006`;\n###################################################### ###\n_prolevel:=false: #assigning default value\n_short cut_in_minimalideal:=true: #assigning default value\n_shortcut_in_Kfie ld:=true: #assigning default value\n_shortcut_in_spinorKbasis:=t rue: #assigning default value\n_shortcut_in_spinorKrepr:=true: #assig ning default value\n_warnings_flag:=true: #assigning defaul t value\ndim_V:=9: #default value\n_scalartypes :=\{RootOf,mathfunc,function,numeric,rational,constant,indexed,complex ,`^`\}:\n_CLIENV[_QDEF_PREFACTOR]:=-1:\n_default_Clifford_product:=cmu lRS: #default Clifford product\n" }}{PARA 0 "" 0 "" {TEXT 371 98 "(1) \+ Global variable _scalartypes contains all types declared by the user t o be of type 'scalar'. \n" }}{PARA 258 "" 0 "" {TEXT -1 303 "(2) Stand ard quaternion basis as Maple global variable as in P. Lounesto \"Clif ford Algebras and Spinors\", page 49. To avoid conflicts with i, j, k , etc. traditionally used in summations, loops, user could define qi, \+ qj, and qk in place of \{i, j, k\} used to denote pure quaternion part of a quaternion.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 "_quatbasis:= [[Id,e3we2,e1we3,e2we1],\{`Maple has assigned qi:=-e2we3, qj:=e1we3, q k:=-e1we2`\}];\n" }}{PARA 0 "" 0 "" {TEXT 367 48 "(3) Defining abbrevi ations 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 942 "`type/clibasmon`:=proc(a)\nlocal a1,i,str,lst,e_set,w_set,ind_lst ,N;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: July 22, \+ 2006`;\n#############################################\n#a1:=simplify(e val(a)):\na1:=eval(a): #no simplify here\n if a1 = Id then return tr ue end if:\n if type(a1,\{string,name,symbol\}) then\n str:=conv ert(a1,string);\n lst:=[seq(str[i],i=1..length(a1))];\n N:=(no ps(lst)+1)/3;\n if N=1 then \n e_set:=\{lst[1]\};\n w_ set:=\{\"w\"\};\n ind_lst:=[lst[2]];\n else\n e_set:= \{seq(lst[3*i-2],i=1..N)\};\n w_set:=\{seq(lst[3*i],i=1..N-1)\}; \n ind_lst:=[seq(lst[3*i-1],i=1..N)];\n end if:\n# print(e_s et,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 else \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. Defini tion of the type " }{TEXT 437 9 "cliscalar" }{TEXT -1 255 ", i.e., Cli fford scalar. A Clifford scalar is essentially any number, function, c onstant, or an algebraic expression not containing any basis monomials (this means that 2*Id is not of type 'cliscalar').\n\nTypical use: ty pe(e1+e2we3+2*Pi*B[1,2],cliscalar);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 760 "`type/cliscalar`:=proc(a::anything) local a1,locscalartypes;\ng lobal `&C`,_scalartypes; \noptions `Copyright (c) 1995-2006 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: July 22, 2006`;\n######################################## #####\na1:=simplify(eval(a)):\nlocscalartypes:=remove(member,_scalarty pes,\{`^`\}):\nif type(a1,\{matrix,list\}) or hastype(a1,clibasmon) 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)\},locsc alartypes))=true)\n then return true \nend if:\nif type(a1,`^`) the n\n if select(hastype,\{a1\},clibasmon)=\{\} then\n return true else error \"illegal expression in %1\",a1 \n end if:\nend if:\nret urn 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 mono mial (of type 'clibasmon') multiplied by a Clifford scalar (of type 'c liscalar').\n\nTypical use: type(e1we2+2*e2,climon);\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 758 "`type/climon`:=proc(x1) local x,S,xx,flag6plu s:\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2 006`;\n#############################################\nx:=simplify(eval (x1)):\nflag6plus:=assigned(Cliplus):\nif hastype(x,cliprod) and not f lag6plus and _warnings_flag then \n WARNING(`argument to 'type/climo n' contains type 'cliprod'. Load 'Cliplus' to extend functionality of CLIFFORD. Type ?cliprod for help.`);\nend if:\n##################\nif not flag6plus then S:=\{'clibasmon'\} else S:=\{'clibasmon','cliprod' \} end if:\nxx:=simplify(x):\nif type(xx,cliscalar) then false\nelif e valb(type(xx,`*`) and nops(select(type,\{op(xx)\},S))=1) then\n true \+ \nelse \n false\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 30 "No. 4. Definition of the type " }{TEXT 439 10 "clipolynom" }{TEXT -1 265 ", i.e., Clifford polynomial. A Clifford polynomial is a multi variate polynomial in the unknowns of type 'climon' or 'cliprod', i.e. , Clifford monomial, with coefficients of the type 'cliscalar', i.e., \+ Clifford scalar.\n\nTypical use: type(e1+2*Pi*e2we3,clipolynom);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 976 "`type/clipolynom`:=proc(x1) local \+ x,flag6plus:\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: \+ July 22, 2006`;\n#############################################\n#x:=si mplify(eval(x1)):\nx:=eval(x1): #no somplify here\nif type(eval(x),\{m atrix,list,set,cliscalar\}) or \n (not type(eval(x),alge braic)) or \n hastype(eval(x),tensorprod) then \nretur n false \nend if:\nflag6plus:=assigned(Cliplus):\nif hastype(x,clipro d) and not flag6plus and _warnings_flag then \n WARNING(`argument to 'type/clipolynom' contains type 'cliprod'. Load 'Cliplus' to extend \+ functionality of CLIFFORD. Type ?cliprod for help.`);\nend if:\nif eva lb(not flag6plus and type(expand(x),`+`) and hastype(x,clibasmon) and \+ not hastype(x,cliprod)) \n then return true \nend if:\nif evalb(fla g6plus and type(expand(x),`+`) and hastype(x,\{clibasmon,cliprod\})) t hen \n return true \nend if: \nreturn false \nend proc:" }}{PARA 0 "" 0 "" {MPLTEXT 0 21 0 "" }{MPLTEXT 1 0 0 "" }}{PARA 0 "" 0 "" {TEXT 432 24 "No. 5. Converts strings " }{TEXT 440 10 "str_to_int" }{TEXT 441 98 " : `1`, `2`, ..., `0` to appropriate digit.\n\nTypical use: ma p(convert,extract(e1we2),str_to_int);\n" }{MPLTEXT 0 21 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 644 "`convert/str_to_int`:=proc(a1::symbol)\n options `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`,remember;\ndescription `Last revised: July \+ 22, 2006`;\nreturn parse(a1);\n####################################### ######\nif args[1] = `0` then return 0 elif\n args[1] = `1` then ret urn 1 elif\n args[1] = `2` then return 2 elif\n args[1] = `3` then return 3 elif\n args[1] = `4` then return 4 elif\n args[1] = `5` \+ then return 5 elif\n args[1] = `6` then return 6 elif\n args[1] = \+ `7` then return 7 elif\n args[1] = `8` then return 8 elif\n args[1 ] = `9` then return 9 else\n return a1\nend if:\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 26 "No. 6. Definition of type " }{TEXT 442 9 "nilpotent" }{TEXT -1 914 ". The following procedure verifies wheth er or not its non-zero argument is a nilpotent element in the given Cl ifford algebra Cl(B). It is expected that a matrix of the bilinear fo rm B has been specified. If the element happens to be an idempotent, or if some power of that element equals the element itself, or if the element is of type 'cliscalar' then the procedure returns 'false'. \+ Otherwise, the procedure checks if any power of its argument up to and including order of 2^N, where N is the maximum index found in the inp ut, is zero.\n\nThis procedurecan also test for nilpotency w.r.t. to a name/symbol/matrix/array which may be passed on as a second element o f list why the first element in the list is the element to be checked \+ for nilpotency. \n\nTypical use: type((1/2)*(e1 +e1we3),nilpotent); \+ #this is a nilpotent element in Cl(3,0) \ntype(p,nilpotent);\ntype([p, K],nilpotent);\ntype([p,-K],nilpotent);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2100 "`type/nilpotent`:=proc(a11) \nlocal a1,i,x,y,xx,k,f lagB,S,lname,flagindexed;global B;\noptions `Copyright (c) 1995-2006 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescr iption `Last revised: July 22, 2006`;\n############################### ##############\n##########################################\n##This cod e allows for passing name of the matrix K as a second element in a lis t:\n##To test element p for nilpotency w.r.t. matrix K enter [p,K];\n# #To test element p for nilpotency w.r.t. B enter p, or, [p,B].\n###### ####################################\nif type(a11,\{cliscalar,clibasmo n,climon,clipolynom\}) then\n a1:=a11:\n lname:=`B`:\n flagindex ed:=false:\n if not type(B,matrix) then error \"matrix must be as signed to B\" \n else flagB:=type(B,diagmatrix) \n end if:\nelif type(a11,list) then\n if nops(a11)<>2 then error \"list m ust have exactly two elements\"\n elif not type(a11[1],\{cliscala r,clibasmon,climon,clipolynom\}) or\n not type(a11[2],\{name ,symbol,matrix,array,`&*`(numeric,\{name,symbol,matrix,array\})\})\n \+ then error \"list must contain clipolynom and name\"\n else\n \+ a1:=a11[1]:\n lname:=a11[2]:\n flagindexed:=true:\n if not ty pe(evalm(lname),matrix) then error \"matrix must be assigned to %1\",l name \n else flagB:=type(evalm(lname),diagmatrix) \n e nd if: \n end if:\nelse\n error \"unexpected argument type\"\nend \+ if:\n###################################\nx:=displayid(a1):\nif a1=0 t hen return true \n elif type(a1,cliscalar) then \n retu rn false \n elif (type(x,clibasmon) and flagB and linalg[det](evalm (lname))<>0) then \n return false \nend if:\n############ ########################\nxx:=cmul[lname](x,x):\nif evalb(xx=0) then r eturn 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^maxin dex(a1) do\n if y=vectorpart(y,0) or y=x then return false end i f: \n y:=cmul(x,y);\n if y=0 then return true end if:\n \+ end do:\nerror \"Sorry, but I am unable to determine nilpotency o f %1\",a1\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 7. Defini tion of type " }{TEXT 443 10 "idempotent" }{TEXT -1 311 ". The follow ing procedure verifies whether or not its argument is an idempotent in the given Clifford algebra Cl(B). It is expected that a matrix of th e bilinear form B has been specified. It can also check element p for \+ being idempotent in Cl(K) if K is entered as a second argument in a li st such as [p,K].\n" }}{PARA 0 "" 0 "" {TEXT 431 124 "Typical use: typ e((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 1574 "`type/idempotent`:=proc(a1 1) \nlocal f,ff,lname,a1,flagindexed,flagB; global B;\noptions `Copyri ght (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n############ #################################\n################################### #######\n##This code allows for passing name of the matrix K as a seco nd 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##########################################\ni f 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 assigned to B\" \n else flagB: =type(B,diagmatrix) \n end if:\nelif type(a11,list) then\n if n ops(a11)<>2 then error \"list must have exactly two elements\"\n \+ elif not type(a11[1],\{cliscalar,clibasmon,climon,clipolynom\}) or\n \+ not type(a11[2],\{name,symbol,matrix,array,`&*`(numeric,\{nam e,symbol,matrix,array\})\})\n then error \"list must contain clip olynom and name\"\n else\n a1:=a11[1]:\n lname:=a11[2]:\n flag indexed:=true:\n if not type(evalm(lname),matrix) then error \"ma trix must be assigned to %1\",lname \n else flagB:=type(eva lm(lname),diagmatrix) \n end if: \n end if:\nelse\n error \"u nexpected argument type\"\nend if:\n################################## ######\nf:=displayid(a1):\nff:=cmul[lname](f,f):\nif evalb(ff=0) then \+ return false end if:\nreturn evalb(simplify(ff-f)=0)\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 8. A new type " }{TEXT 444 9 "clima trix" }{TEXT -1 424 " is a matrix with at least one entry of type 'cli polynom'. Note that anything in Maple that has been defined via the pr ocedure linalg[matrix] is of the standard Maple type 'matrix' includin g matrices with entries in a Clifford algebra. Since a matrix with num erical entries is not of the type 'climatrix', this procedure allows o ne to distinguish such matrix from those that do have at least one ent ry in a Clifford algebra." }}{PARA 258 "" 0 "" {TEXT -1 208 "\nMatrice s of the type 'matrix' but not 'climatrix' may be multiplied using sta ndard Maple matrix multiplication operator `&*`.\n\nMatrices of the ty pe 'climatrix' must be multiplied using the procedure 'rmulm'." }} {PARA 0 "" 0 "" {TEXT 430 104 "\nTypical use: M:=linalg[matrix](2,2,[e 1,e3we4+e3,e4,Id-e1]);\n type(M,climatrix);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 352 "`type/climatrix`:=proc(x)\noptio ns `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n## ###########################################\nif type(x,array) then\n \+ return evalb(select(type,convert(x,set),\{clipolynom,climon,clibasmon \})<>\{\})\nelse \n return false\nend if:\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 429 37 "No. 9. Useful conversion function to " }{TEXT 445 5 "mlist" }{TEXT 446 20 " needed by 'rmulm'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 365 "`convert/mlist`:=proc(a1::matrix) local i,longlist; \noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: July 22, 200 6`;\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 544 "`type/fieldelement`:=pro c(a1::algebraic) global f; \noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: July 22, 2006`;\n###################################### #######\nif not assigned(f) then \n error \"primitive idempotent f h as not been assigned yet\" \nend if:\nif not type(f,primitiveidemp) th en \n error \"although f has been assigned, it is not of type/primit iveidemp\"\nend if:\nif member(squaremodf(args[1],f),\{-1,1\}) then re turn true else return false end if \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 427 20 "No. 11. A new type: " }{TEXT 449 9 "symmatrix" }{TEXT 450 25 " - a symmetric matrix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 466 "`type/symmatrix`:=proc(a1::\{name,symbol,matrix,`&*`(algebraic,ma trix)\}) \noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Be rtfried Fauser. All rights reserved.`;\ndescription `Last revised: Jul y 22, 2006`;\n#############################################\nif evalb( evalm(a1)=a1) then return false end if:\nif linalg[coldim](a1)<>linalg [rowdim](a1) then\n error \"B must be assigned square matrix\" \nend if:\nreturn linalg[equal](a1,linalg[transpose](a1))\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 426 20 "No. 12. A new type: " }{TEXT 451 13 "ant isymmatrix" }{TEXT 452 31 " - an anti-symmetric matrix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 471 "`type/antisymmatrix`:=proc(a1::\{name,sy mbol,matrix,`&*`(algebraic,matrix)\}) \noptions `Copyright (c) 1995-20 06 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nd escription `Last revised: July 22, 2006`;\n########################### ##################\nif evalb(evalm(a1)=a1) then return false end if:\n if linalg[coldim](a1)<>linalg[rowdim](a1) then\n error \"B must be a ssigned square matrix\" \nend if:\nreturn linalg[equal](a1,-linalg[tra nspose](a1))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 425 20 "No. 13. A n ew type: " }{TEXT 453 10 "diagmatrix" }{TEXT 454 25 " - a diagonal \+ matrix.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 479 "`type/diagmatrix`:=pr oc(a1::anything) local N,i,DD;\noptions `Copyright (c) 1995-2006 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: July 22, 2006`;\n################################### ##########\nif not type(a1,\{matrix,`&*`(algebraic,matrix)\}) then ret urn false end if:\nif not type(a1,symmatrix) then return false end if: \n N:=linalg[coldim](a1):\n DD:=linalg[diag](seq(a1[i,i],i=1..N)):\n return linalg[iszero](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 505 "`type/primitive idemp`:=proc(f::idempotent) local p,q,numfact;global B;\noptions `Copy right (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`;\ndescription `Last revised: July 22, 2006`;\n########## ###################################\nif not type(B,matrix) then \n e rror \"B must be assigned square matrix\" \nelse\n p:=Bsignature(B)[ 1]:q:=Bsignature(B)[2]\nend if:\nnumfact:=q-RHnumber(q-p):\nif scalarp art(f)=1/2^numfact then \n return true \nelse \n return false \nen d if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 13 "No. 15. Type " } {TEXT 456 13 "purequatbasis" }{TEXT -1 109 " is a procedure which chec ks if the given list of three basis monomials can be a basis for pure \+ quaternions.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 917 "`type/purequatba sis`:=proc(l1::list(\{clibasmon,climon,clipolynom\})) \nlocal p,q,r;gl obal B;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bert fried Fauser. All rights reserved.`;\ndescription `Last revised: July \+ 22, 2006`;\n#############################################\nif nops(l1) <> 3 then \n error \"list must have exactly 3 elements of type 'cli basmon', 'climon', or 'clipolynom' but received a list with %1 element s\",nops(l1)\nend if:\nif not type(B,matrix) then \n error \"square \+ matrix must be assigned to B\"\nend if: \np:=l1[1]:q:=l1[2]:r:=l1[3]: \nif cmul(p,p)<>-Id then return false elif\n cmul(q,q)<>-Id then ret urn false elif\n cmul(r,r)<>-Id then return false elif\n not membe r(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 return 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 generalized co mplex element of Cl(B). A Clifford polynomial p in Cl(B) is of this t ype if it belongs to a subalegbra A of Cl(B) isomorphic to complex num bers C. Knowing that the given polynomial p is of that type allows for finding the inverse of p in A < Cl(B) a more efficient way by the pro cedure '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 883 "`type/gencomplex`:=proc(a1::\{cliscalar,clibasmon, climon,clipolynom\}) local L;global B;\noptions `Copyright (c) 1995-20 06 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nd escription `Last revised: July 22, 2006`;\n########################### ##################\nif not type(B,matrix) then \n error \"can't chec k type since B is not assigned a matrix\" \nend if:\nif type(a1,clisca lar) then return false end if:\nL:=[op(cliterms(reorder(a1)))];\nif no ps(L)>2 then return false end if:\nif nops(L)=1 and L=[Id] then return false end if:\nif nops(L)=2 and not member(Id,L) then return false en d if:\nL:=remove(member,L,[Id]);\nif maxindex(L)>linalg[coldim](B) the n \n error \"can't check type since the largest index in %1 is great er than size %2 of current form B\", a1,linalg[coldim](B)\nend if:\nif cmul(L[1],L[1])=-Id then \n return true \nelse \n return false \+ \nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 17. A new type: " }{TEXT 458 13 "genquaternion" }{TEXT -1 513 " - a generalized quaternionic element of Cl(B). A Clifford polynomial p in Cl(B) is o f this type if it belongs to a subalegbra A of Cl(B) isomorphic to a d ivision ring H of quaternions. Knowing that the given polynomial 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 of grade \+ 0 (eg., 2*Id) and elements of type 'gencomplex' - a generalized comple x element of Cl(B), are not of this type.\n\nTypical use: type(p,genqu aternion);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 660 "`type/genquaternio n`:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local L;global B;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: July 22, \+ 2006`;\n#############################################\nif not type(B,m atrix) then \n error \"square matrix must be assigned to B\" \nend i f:\nif type(a1,cliscalar) then return false end if:\nL:=[op(cliterms(r eorder(a1)))];\nif nops(L)>4 or type(a1,gencomplex) then return false \+ end if:\nL:=remove(member,L,[Id]);\nif nops(L)=1 then return false end if:\nif nops(L)=2 then L:=[op(L),cmul(L[1],L[2])] end if:\nreturn typ e(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 are even elements, odd elements, or neither in Cl(B).\n\nTypical use: type(p,evenelement );\n type(p,oddelement);\n\nwhere p is a Clifford p olynomial.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 769 "`type/evenelement` :=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\})\noptions `Copyri ght (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n############ #################################\nif type(eval(a1),cliscalar) then re turn true end if:\nreturn evalb(reorder(displayid(eval(a1)-gradeinv(ev al(a1))))=0)\nend proc:\n\n`type/oddelement`:=proc(a1::\{cliscalar,cli basmon,climon,clipolynom\})\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: July 22, 2006`;\n###################################### #######\nif type(eval(a1),cliscalar) then return false end if:\nreturn evalb(reorder(displayid(eval(a1)+gradeinv(eval(a1))))=0)\nend proc:\n " }}{PARA 0 "" 0 "" {TEXT 424 18 "No. 20. New type: " }{TEXT 461 10 "q uaternion" }{TEXT 462 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 893 "`ty pe/quaternion`:=proc(q::algebraic) local aa1,aa2,S;global B,qi,qj,qk; \noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: July 22, 200 6`;\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 identity 3 x 3 matrix.\"\nend \+ if:\nif not linalg[equal](B,linalg[diag](1$3)) then \n error \"ident ity 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(expand(eval(q)))))\};\naa2:=\{Id ,e1we2,e1we3,e2we3\};#standard basis to be compared to\nS:=aa1 minus a a2;\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 ty pes from the package 'GTP' for 'Graded Tensor Product'. This is an ex perimental package for computations with graded tensor products of Cli fford algebras." }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 329 "`type/tensorprod`:=proc(a1::anything)\noptions `Copyright (c) 199 5-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.` ;\ndescription `Last revised: July 22, 2006`;\n####################### ######################\nif type(a1,function) and op(0,a1)=`&t` then re turn true else return false end if:\nreturn false\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{MPLTEXT 1 0 0 "" }}{PARA 0 "" 0 "" {TEXT 422 18 "No. 22. New type: " }{TEXT 465 12 "genquatbasis" }{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\}, genquatbasis);\n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 1472 "`type/genquatbasis`:=proc(L::\{list(\{clis calar,clibasmon,climon,clipolynom\}),\n s et(\{cliscalar,clibasmon,climon,clipolynom\})\}) \nlocal f,p,q,k,loc,i ;global B;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\n############################# ################\ndescription `Last revised: July 22, 2006`;\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,mat rix) then \n error \"square matrix must be assigned to B first\" \ne nd 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 idempoten t\" \nend if:\nloc:=remove(member,L,\{f\}); #assign remaining e lements of L to loc \np,q,k:=seq(loc[i],i=1..3): #assign eleme nts of loc to p,q,k\n##################################\nif cmul(p,p)< >cmul(-Id,f) then return false elif\n cmul(q,q)<>cmul(-Id,f) then re turn false elif\n cmul(k,k)<>cmul(-Id,f) then return false \nend if: \n################################## \nif (cmul(p,q)=cmul(k,f) and c mul(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)) \nor\n \+ (cmul(p,q)=-cmul(k,f) and cmul(q,p)=cmul(k,f) and \n cmul(q,k)=-cmu l(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:\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 23. New type" }{TEXT 421 2 ": " }{TEXT 467 7 "cliprod" }{TEXT 468 117 "\n\nUse: type(e1we2 \+ &C e3, cliprod); type(`&C`(e1,e2),cliprod); type(`&C`[K](e1,e2),clipro d); type(&C(e1,e2),cliprod);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 313 " `type/cliprod`:=proc(f::\{function,anything\}) local p;\noptions `Copy right (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`;\ndescription `Last revised: July 22, 2006`;\n########## ###################################\nevalb(member(op(0,f),\{`&C`\}) or member(op(0,op(0,f)),\{`&C`\}))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 433 18 "No. 24. Procedure " }{TEXT 469 16 "convert/dfmatrix" } {TEXT 470 84 " converts a list of matrices or a pair of matrices inot \+ a matrix over double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 965 "` convert/dfmatrix`:=proc() local l1,l2,L,i,j,m,n,m1,m2,MN;\noptions `Co pyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: July 22, 2006`;\n######## #####################################\nif nargs=1 and type(args[1],dfm atrix) \n then return args[1]\nelif nargs=1 and type(arg s[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:=ev alm(args[1]),evalm(args[2])\nelse error \"wrong number or types of arg uments\" \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 := linalg[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(M N)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 434 18 "No. 25 . Procedure " }{TEXT 471 13 "type/dfmatrix" }{TEXT 472 73 " checks if \+ a matrix is of type 'dfmatrix', that is, over a double field.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 493 "`type/dfmatrix`:=proc(m::anything) local mm;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: Ju ly 22, 2006`;\n#############################################\nif not t ype(m,matrix) and not type(m,list(matrix)) then return false end if:\n if type(m,matrix) then \n return type(convert(m,mlist),\n l ist(list(\{cliscalar,clibasmon,climon,clipolynom,numeric,symbol,algebr aic\})))\nelse\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 Clifford:-setup:" }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2301 "`&c`:=proc() local NP,ARGS,coB,nameB,lname,decindex ,flagdec;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Be rtfried Fauser. All rights reserved.`;\ndescription `Last revised: Jul y 22, 2006`;\n#############################################\n######### ##############################\n### Works when &c[''K''] or &c[''-K''] is entered and K is a matrix\n####################################### \nflagdec:=true:\nif type(op(procname),procedure) then\n if type([ar gs],listlist) then\n if type(op(args),array) then\n WARNI NG(\"enclose index in double quotes as in &c[''B''] or &c[''-B''] when B has been assigned a matrix to avoid the following:\");\n ret urn '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 typ e(lname,`&*`(numeric,name)) then\n coB:=op(select(type,\{op(ln ame)\},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],l istlist) then\n if type(op(args),function) then\n ARGS:=op(op(a rgs));\n coB:=1:\n nameB:=eval(op(0,op(args)));\n if ty pe(nameB,`&*`(numeric,name)) then\n coB:=op(select(type,\{op(n ameB)\},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,nume ric));\n nameB:=op(select(type,nameB,function));\n ARGS:=op( nameB);\n nameB:=op(0,nameB);\n else\n error \"unable to d etermine 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 A RGS:=args;\n coB:=1:\n nameB:=`B`; #default name \nelse\n error \+ \"cannot determine arguments and/or index from arguments\"\n end if;\n return coB,nameB,[ARGS];\nend proc:\n################################# ####\nif flagdec then \n coB,nameB,ARGS:=decindex(args);\n lname:= coB*nameB;\nend if;\nNP:=nops(ARGS);\nif member(0,ARGS) then return 0 \+ end if;\nif NP <=1 then return op(ARGS) end if;\nreturn cmul[eval(lnam e)](op(ARGS)); \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2377 "` &cQ`:=proc() local NP,ARGS,coB,nameB,lname,decindex,flagdec;\noptions \+ `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n##### ########################################\n############################ ###########\n### Works when &cQ[''K''] or &cQ[''-K''] is entered and K is a matrix\n#######################################\nflagdec:=true: \nif type(op(procname),procedure) then\n if type([args],listlist) th en\n if type(op(args),array) then\n WARNING(\"enclose ind ex in double quotes as in &cQ[''B''] or &cQ[''-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 \+ from or wrong 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 arguments and/or index from arguments\"\nend if;\nreturn coB ,nameB,[ARGS];\nend proc:\n#####################################\nif f lagdec 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;\ni f NP <=1 then return op(ARGS) end if;\nreturn cmul[eval(lname)](op(ARG S));\n#return cmulQ[eval(lname)](op(ARGS)); ###Causes an error in `&cQ ` \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1852 "`&cQm`:=proc() local ARGS,lname,NP,coB,nameB,decindex;\noptions `Copyright (c) 1995- 2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: July 22, 2006`;\n######################## #####################\n#######################################\nif typ e([args],listlist) then\n if type(op(args),array) then\n WARNIN G(\"enclose index in double quotes as in &cQm[''B''] or &cQm[''-B''] w hen B has been assigned a matrix to avoid the following:\");\n re turn ('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 &cQm, try enclosin g name of the index in double quotes as in &cQm[''B''] or &cQm[''-B''] \"\n end if;\nelif\n type([args],list) then\n ARGS:=args;\n co B:=1:\n nameB:=`B`; #default name \nelse\n error \"cannot determin e arguments and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\nend pro c:\n#####################################\ncoB,nameB,ARGS:=decindex(ar gs);\nlname:=coB*nameB:\n NP:=nops(ARGS);\n if member(0,ARGS) then r eturn 0 end if;\n if NP <=1 then \n return op(ARGS)\n elif NP = \+ 2 then \n return rmulm(eval(ARGS[1]),eval(ARGS[2]),cmulQ,lname) \n else\n error \"only two arguments and index are allowed\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2444 "`&cm`:=proc( ) local NP,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyright \+ (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: July 22, 2006`;\n################ #############################\n####################################### \n### Works when &cm[''K''] or &cm[''-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 &cm[''B''] or &cm[''-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 lna me:=op(procname);\n ARGS:=[args];\n if type(lname,`&*`(numeric ,name)) then\n coB:=op(select(type,\{op(lname)\},numeric));\n \+ nameB:=op(select(type,\{op(lname)\},name));\n else\n \+ coB:=1:\n nameB:=lname:\n end if;\n flagdec:=false :\nend if;\n#######################################\ndecindex:=proc() \+ local ARGS,coB,nameB;global B;\nif type([args],listlist) then\n if t ype(op(args),function) then\n ARGS:=op(op(args));\n coB:=1: \n nameB:=eval(op(0,op(args)));\n if type(nameB,`&*`(numeric ,name)) then\n coB:=op(select(type,\{op(nameB)\},numeric));\n \+ nameB:=op(select(type,\{op(nameB)\},name));\n end if;\n \+ elif type(op(args),`&*`(numeric,function)) then\n nameB:=\{op(o p(args))\}:\n coB:=op(select(type,nameB,numeric));\n nameB:= op(select(type,nameB,function));\n ARGS:=op(nameB);\n nameB: =op(0,nameB);\n else\n error \"unable to determine index or wro ng index: use name in double quotes as in &cm[''B''] or &cm[''-B'']\" \n end if;\nelif\n type([args],list) then\n ARGS:=args;\n coB: =1:\n nameB:=`B`; #default name \nelse\n error \"cannot determine \+ arguments and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc: \n#####################################\nif flagdec then \n coB,name B,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 if;\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 error \"only two arguments and index are allowed\"\n end if;\nen d proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 229 "`&q`:=proc()\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. Al l rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n#### #########################################\nreturn qmul(args) \nend pro c:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 462 "`&qm`:=proc() local NP: \n options `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: July 22, 2006` ;\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]),eva l(args[2]),qmul) \n else\n error \"only two arguments are allowed in &qm\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 346 "`&om`:=proc()\noptions `Copyright (c) 1995-2006 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: July 22, 2006`;\n#############################################\n if not assigned(Octonion) then\n error \"package 'Octonion' must be \+ loaded first\"\nend if;\nreturn subs(Id=1,rmulm(args,Octonion:-omul)) \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1844 "`&rm`:=proc() lo cal ARGS,lname,NP,coB,nameB,decindex;\noptions `Copyright (c) 1995-200 6 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: July 22, 2006`;\n############################ #################\n#######################################\nif type([a rgs],listlist) then\n if type(op(args),array) then\n WARNING(\" 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([ar gs],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,name B,numeric));\n nameB:=op(select(type,nameB,function));\n ARG S:=op(nameB);\n nameB:=op(0,nameB);\n else\n error \"unabl e to determine index or wrong index type for &rm, try enclosing name o f 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 argument s and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc:\n###### ###############################\ncoB,nameB,ARGS:=decindex(args);\nlnam e:=coB*nameB:\n NP:=nops(ARGS);\n if member(0,ARGS) then return 0 en d 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 else\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() return wedg e(args) end proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 463 "`&wm`:=proc () local NP: \noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz an d Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\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(eva l(args[1]),eval(args[2]),wedge) \n else\n error \"only two argume nts are allowed in &wm\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 188 "#################################################### \nend proc: ###<< " 0 "" {MPLTEXT 1 0 11 "libname[2];" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q7C:\\Maple10/Cliffordlib6\"" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 "savelib('Clifford'):\n" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 "march('listdir',libname[2]);" }} {PARA 11 "" 1 "" {XPPMATH 20 "6#7#7&QAC:\\Maple10/Cliffordlib\\maple.l ib6\"7(\"%1?\"\"'\"#@F*\"#L\"#;Q)WRITABLEF&\"\"!" }}}{EXCHG {PARA 0 " " 0 "" {TEXT -1 59 "Let's add library files to the main library in lib name[1]:\n" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 455 "march('add', libname[2],`C:\\\\Maple10/Clifforddata/matrealL.m`,`matrealL.m`);\nmar ch('add',libname[2],`C:\\\\Maple10/Clifforddata/matrealR.m`,`matrealR. m`);\nmarch('add',libname[2],`C:\\\\Maple10/Clifforddata/matcompL.m`,` matcompL.m`);\nmarch('add',libname[2],`C:\\\\Maple10/Clifforddata/matc ompR.m`,`matcompR.m`);\nmarch('add',libname[2],`C:\\\\Maple10/Clifford data/matquatL.m`,`matquatL.m`);\nmarch('add',libname[2],`C:\\\\Maple10 /Clifforddata/matquatR.m`,`matquatR.m`);" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matrealL.m\" already in archive, skipping\n" }} {PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matrealR.m\" already in archive, skipping\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, skippi ng\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matquatL.m\" al ready in archive, skipping\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$\"\")\"\"!7#7$\"\"\"\"\"(7#7$\"\"$ F-7#7$\"\"%F-7#7$\"\"*F&7#7$F&\"\"'7#7$F-F)7#7$F0F07#7$F0\"\"#7#7$F=F) 7#7$F&F*7#7$\"\"&F07#7$FDF-7#7$F=F=7#7$F&F%7#7$F=F&7#7$F)F%7#7$F)F)7#7 $F-F=" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matrealR); " }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\")\"\"!7#7$\"\"\"\"\"(7#7$ \"\"$F-7#7$\"\"%F-7#7$\"\"*F&7#7$F&\"\"'7#7$F-F)7#7$F0F07#7$F0\"\"#7#7 $F=F)7#7$F&F*7#7$\"\"&F07#7$FDF-7#7$F=F=7#7$F&F%7#7$F=F&7#7$F)F%7#7$F) F)7#7$F-F=" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matco mpL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\")\"\"\"7#7$\"\"%F&7#7 $\"\"&\"\"#7#7$\"\"$F)7#7$F&\"\"'7#7$\"\"(\"\"!7#7$F0F77#7$F3F07#7$F&F -7#7$F)F,7#7$F-F07#7$F-F67#7$F7F,7#7$F7\"\"*" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matcompR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\")\"\"\"7#7$\"\"%F&7#7$\"\"&\"\"#7#7$\"\"$F)7#7$F&\"\"'7# 7$\"\"(\"\"!7#7$F0F77#7$F3F07#7$F&F-7#7$F)F,7#7$F-F07#7$F-F67#7$F7F,7# 7$F7\"\"*" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matqua tL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"(\"\"#7#7$\"\"\"\"\"%7 #7$F)\"\"$7#7$F%F)7#7$F*\"\"!7#7$F&\"\"&7#7$F5F27#7$F5F)7#7$F2F*7#7$\" \"'F)7#7$F>F&7#7$F2F&7#7$F-F57#7$F&F*7#7$F&F>7#7$F>F27#7$F-F>7#7$F)F57 #7$F2F-" }}}{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$F&\"\"&7#7$F5F27#7$F5F)7#7$F2F*7#7$\"\" 'F)7#7$F>F&7#7$F2F&7#7$F-F57#7$F&F*7#7$F&F>7#7$F>F27#7$F-F>7#7$F)F57#7 $F2F-" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 258 "" 0 "" {TEXT -1 985 "Last revised: July 22, 2006\n\nNOTES:\n\n1. \+ The table name, e.g., Clifford, and the file name, e.g., Clifford.m mu st be the same.\n2. March commands useful in creating and viewing libr ary file (issue in DOS window):\n\nC:\\Maple10>bin.wnt\\march -c Cliff ordlib 20 - creates library in a existing empty directory \\Cliffor dlib\nC:\\Maple10>bin.wnt\\march -l Cliffordlib - list all entries in the library Cliffordlib\nC:\\Maple10>bin.wnt\\march -l Cliffordlib > \+ list.txt - list all entries in the library Cliffordlib and write them into file list.txt\nC:\\Maple10>bin.wnt\\march -d Cliffordlib Cliffor d.m - delete Clifford.m from the library Cliffordlib\n\n3. Global var iable savelibname is empty, but savelib() automatically assigns libnam e[1] to savelibname for the purpose of saving package there with the c ommand savelib().\n4. Maple initialization file maple.ini contains lib name augmented by the path and the directory name \\Cliffordlib where \+ the Clifford 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 m odule:\n###march('create',Cliffordlib,500);\n###savelib(Clifford,`Clif ford.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%*clilinear G%+climinpolyG%)cliparseG%*cliremoveG%)clisolveG%(clisortG%)clitermsG% %cmulG%(cmulNUMG%&cmulQG%'cmulRSG%(cmulgenG%(cocycleG%2commutingelemen tsG%,conjugationG%*ddfmatrixG%,diagonalizeG%*displayidG%(extractG%1fac toridempotentG%)find1strG%*findbasisG%)gradeinvG%%initG%/isVahlenmatri xG%*isproductG%,makealiasesG%.makeclibasmonG%)matKreprG%)maxgradeG%)ma xindexG%*mdfmatrixG%-minimalidealG%$ordG%)permsignG%*pseudodetG%)q_con jugG%)qdisplayG%%qinvG%%qmulG%&qnormG%-rd_clibasmonG%*rd_climonG%.rd_c lipolynomG%(reorderG%*reversionG%&rmulmG%&rot3dG%+scalarpartG%%sexpG%2 specify_constantsG%-spinorKbasisG%,spinorKreprG%+squaremodfG%0subs_cli polynomG%+useproductG%+vectorpartG%(versionG%&wedgeG%%wexpG" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}}}{MARK "19 0 0" 0 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }