{VERSION 5 0 "IBM INTEL NT" "5.0" } {USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 1 0 0 0 0 1 }{CSTYLE "2D Math" -1 2 "Times" 0 1 0 0 0 0 0 0 2 0 0 0 0 0 0 1 }{CSTYLE "2D Output" 2 20 "" 0 1 0 0 255 1 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" 0 21 "" 0 1 0 0 0 1 0 0 0 0 2 0 0 0 0 1 }{CSTYLE "" -1 256 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 257 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 258 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 259 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 260 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 261 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 262 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 263 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 264 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 265 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 266 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 267 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 268 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 269 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 270 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 271 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 272 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 273 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 274 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 275 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 276 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 277 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 278 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 279 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 280 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 281 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 282 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 283 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 284 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 285 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 286 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 287 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 288 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 289 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 290 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 291 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 292 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 293 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 294 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 295 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 296 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 297 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 298 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 299 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 300 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 301 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 302 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 303 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 304 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 305 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 306 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 307 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 308 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 309 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 310 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 311 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 312 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 313 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 314 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 315 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 316 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 317 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 318 "Helvetica" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 319 "Helvetica" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 320 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 321 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 322 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 323 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 324 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 325 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 326 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 327 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 328 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 329 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 330 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 331 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 332 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 333 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 334 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 335 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 336 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 337 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 338 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 339 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 340 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 341 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 342 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 343 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 344 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 345 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 346 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 347 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 348 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 349 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 350 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 351 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 352 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 353 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 354 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 355 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 356 "" 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 357 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 358 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 359 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 360 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 361 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 362 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 363 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 364 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 365 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 366 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 367 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 368 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 369 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 370 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 371 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 372 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 373 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 374 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 375 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 376 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 377 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 378 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 379 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 380 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 381 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 382 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 383 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 384 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 385 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 386 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 387 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 388 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 389 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 390 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 391 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 392 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 393 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 394 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 395 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 396 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 397 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 398 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 399 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 400 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 401 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 402 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 403 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 404 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 405 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 406 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 407 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 408 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 409 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 410 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 411 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 412 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 413 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 414 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 415 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 416 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 417 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 418 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 419 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 420 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 421 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 422 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 423 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 424 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 425 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 426 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 427 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 428 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 429 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 430 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 431 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 432 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 433 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 434 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 435 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 436 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 437 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 438 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 439 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 440 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 441 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 442 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 443 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 444 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 445 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 446 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 447 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 448 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 449 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 450 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 451 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 452 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 453 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 454 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 455 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 456 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 457 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 458 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 459 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 460 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 461 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 462 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 463 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 464 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 465 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 466 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 467 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 468 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 469 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 } {CSTYLE "" -1 470 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 471 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 472 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 473 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 474 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {CSTYLE "" -1 475 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 476 "" 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 477 "" 1 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 478 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 }{CSTYLE "" -1 479 "" 0 1 0 0 0 0 0 2 0 0 0 0 0 0 0 1 } {PSTYLE "Normal" -1 0 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "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 "Maple Outpu t" -1 12 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 } 1 3 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "R3 Font 0" -1 256 1 {CSTYLE "" -1 -1 "Helvetica" 1 12 0 0 255 1 2 1 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "R3 Font 2" -1 257 1 {CSTYLE "" -1 -1 "Times" 1 12 255 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 } {PSTYLE "Normal" -1 258 1 {CSTYLE "" -1 -1 "Helvetica" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }} {SECT 0 {EXCHG {PARA 258 "" 0 "" {TEXT -1 28 "\nThis is clifford_M7_01 .mws\n" }}{PARA 258 "" 0 "" {TEXT -1 60 "(Created: October 9, 2002)\n( Last revised: November 5, 2002)\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "################################################################ #############\n# \+ #\n#DISCLAIMER: \+ #\n# \+ #\n#THERE IS NO WARRANTY FOR TH E CLIFFORD, BIGEBRA, Cliplus, Octonion, GTP #\n#PACKAGES TO THE EX TENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE #\n# PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IM PLIED, #\n#INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF ME RCHANTABILITY #\n#AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE R ISK AS TO THE QUALITY #\n#AND PERFORMANCE OF THE PROGRAM IS WITH YO U. SHOULD THE PROGRAM PROVE #\n#DEFECTIVE, YOU ASSUME THE COST O F ALL NECESSARY SERVICING, REPAIR OR #\n#CORRECTION. \+ #\n############### ##############################################################\n" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 322 "This is a listing (without examples) of all procedures in a Maple package \+ called 'CLIFFORD' (Version 7, Copyright 1995-2003 by Rafal Ablamowic z, Tennessee Technological University), and Bertfried Fauser, Univers it\"at Konstanz, for Maple 7. User will know which version he/she is u sing by using the 'version()' function." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 277 55 "The following procedures can use in dex such as K or -K:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 " " {TEXT -1 66 "cmul[K](p1,p2,...,pn); ##Clifford product of p1,p2,..., pn in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 81 "&c[K](p1,p2,...,pn); ##Cli fford product of p1,p2,...,pn in Cl(K) (ampersand form)" }}{PARA 0 "" 0 "" {TEXT -1 112 "cmulQ[K](p1,p2,...,pn); ##Clifford product of p1,p2 ,...,pn in Cl(K) (here K is expected to be a diagonal matrix)" }} {PARA 0 "" 0 "" {TEXT -1 126 "&cQ[K](p1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (here K is expected to be a diagonal matrix) , ampersand form" }}{PARA 0 "" 0 "" {TEXT -1 56 "cexp[K](p,N); ## expo nential of p in Cl(K) up to order N" }}{PARA 0 "" 0 "" {TEXT -1 102 "c expQ[K](p,N); ## exponential of p in Cl(K) up to order N (here K is ex pected to be a diagonal matrix)" }}{PARA 0 "" 0 "" {TEXT -1 53 "climin poly[K](p); ## minimal polynomial of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 91 "sexp[K](p,N); ## exponential of p in Cl(K) up to order N \+ modulo the minimal polynomial of p" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 0 "" 0 "" {TEXT 278 96 "The following procedures can use name K \+ or a numeric multiple of a name as an optional argument:" }}{PARA 0 " " 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 106 "LC(p1,p2,K); ##le ft contraction of p2 by p1 w.r.t. K\nRC(p1,p2,K); ##right contraction \+ of p1 by p2 w.r.t. K" }}{PARA 0 "" 0 "" {TEXT -1 68 "cmulNUM(m1,m2,K); ##Clifford (numeric) product of m1 and m2 in Cl(K)" }}{PARA 0 "" 0 " " {TEXT -1 41 "reversion(p,K); ##reversion of p in Cl(K)" }}{PARA 0 " " 0 "" {TEXT -1 43 "cinv(p,K); ##Clifford inverse of p in Cl(K)" }} {PARA 0 "" 0 "" {TEXT -1 73 "LCQ(p1,p2,K); ##left contraction of p2 by p1 w.r.t. diagonal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 74 "RCQ(p 1,p2,K); ##right contraction of p1 by p2 w.r.t. diagonal entries in K " }}{PARA 0 "" 0 "" {TEXT -1 46 "conjugation(p,K); ## conjugation of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 279 86 "The folllowing procedures can pass on name or a numeric multip le of a name via a list:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 " " 0 "" {TEXT -1 121 "type([p,K],nilpotent); ## checks if p is nilpoten t in Cl(K)\ntype([p,K],idempotent); ## checks if p is idempotent in Cl (K)" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 580 "\nProcedures that define types: `type/climon`, `type/clipolynom`, `type/climatrix` as well as other procedures such as 'reorder', 'wedg e', etc., have been substantially revised to improve efficiency and sp eed of the package. This work has been done together with Bertfried Fa user, Universit\"at Konstanz, in Cookeville on October 5, 2001. \n\nTh is version includes \"Bigebra\" package that has been created together with Bertfried Fauser, Universit\"at Konstanz, Konstanz, Germany. Add itional help pages have been written and added to the database that ex plain the usage of this package." }{TEXT 276 0 "" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 301 "An additional feature \+ in this version is an ability to display and change environmental vari ables. They can be displayed with procedure CLIFFORD_ENV.\n\nThis pack age is made to run under Maple 7. It is available on a server of the Department of Mathematics, Tennessee Technological University, at: \+ \n" }}{PARA 258 "" 0 "" {TEXT -1 69 " http ://math.tntech.edu/rafal/clifford/ " }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 130 "In order to create a Maple file 'C lifford.m' containing the 'CLIFFORD' package, execute this worksheet. \n\nTo load the package type:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 17 ">with(Clifford); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 189 "You will know if the p ackage has been loaded because a list with Clifford procedures will be displayed on the screen. To check the current version of the package , at the Maple prompt type " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 12 ">version( );" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 35 "Rafal Ablamowicz, Ph.D. and Chair " }}{PARA 258 "" 0 "" {TEXT -1 35 "Department of Mathemati cs, Box 5054" }}{PARA 258 "" 0 "" {TEXT -1 36 "Tennessee Technological University " }}{PARA 258 "" 0 "" {TEXT -1 21 "Cookeville, TN 38505 \+ " }}{PARA 258 "" 0 "" {TEXT -1 24 "rablamowicz@tntech.edu " }}{PARA 258 "" 0 "" {TEXT -1 25 "phone: USA (931) 372-3569" }}{PARA 258 "" 0 " " {TEXT -1 23 "fax: USA (931) 372-6353" }}{PARA 0 "" 0 "" {TEXT -1 1 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 "restart:\nunprotect('Clifford ','e','qi','qj','qk','Id','w');" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 989 "Clifford:=module()\n###################################\nexport `&m`, Bsignature, CLIFFORD_ENV, Kfield, LC, LCQ, RC, RCQ, RHnumber, adfmatr ix, all_sigs, beta_minus, beta_plus, buildm, bygrade, c_conjug, cbasis , cdfmatrix, cexp, cexpQ, cinv, clibilinear, clicollect, clidata, clil inear, climinpoly, cliparse, cliremove, clisolve, clisort, cliterms, c mul, cmulNUM, cmulQ, cmulRS, cmulgen, cocycle, commutingelements, conj ugation,ddfmatrix, diagonalize, displayid, extract, factoridempotent, \+ find1str, findbasis, gradeinv, init, isVahlenmatrix, isproduct, makeal iases, makeclibasmon, matKrepr, maxgrade, maxindex, mdfmatrix, minimal ideal, ord, permsign, pseudodet, q_conjug, qdisplay, qinv, qmul, qnorm , reorder, reversion, rmulm, rot3d, scalarpart, sexp, specify_constant s, spinorKbasis, spinorKrepr, squaremodf, subs_clipolynom, useproduct, vectorpart, version, wedge, wexp, rd_clibasmon, rd_climon, rd_clipoly nom;\n###################################\nlocal setup;\noption packag e, load=setup;\n" }}{PARA 258 "" 0 "" {TEXT -1 84 "No. 1. Name 'versio n' stores information about the current version of the package. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 25 "Typic al use: version(); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1523 "version:= proc()\noptions `Copyright (c) 1995- 2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: November 5, 2002`;\nprint(`++++++++++++++ +++++++++++++++++++++++++++++`);\nprint(`CLIFFORD - A Maple 7 Package \+ for Clifford Algebras`); \nprint(`(Version 7 with global variable _pro level and \"Bigebra\" package)`);\nprint(`\"Bigebra\" package written \+ with Bertfried Fauser, Universit\"at Konstanz`);\nprint(`Last revised: November 5, 2002 (Source file: clifford_M7_01.mws)`);\nprint(`Copyrig ht 1995-2003 by Rafal Ablamowicz (*) and Bertfried Fauser ($)`);\nprin t(``);\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(` rabl amowicz@tntech.edu`);\nprint(` http://math.tntech.edu/rafal/Cliffor d/`);\nprint(`($) Universit\"at Konstanz, Fachbereich Physik, Fach M67 8`);\nprint(` 78457 Konstanz, Germany`);\nprint(` Bertfried.Faus er@uni-konstanz.de`);\nprint(` http://kaluza.physik.uni-konstanz.de /~fauser/`); \nprint(``);\nprint(`If you are a Clifford algebra p ro, assign 'true' to '_prolevel' and see`);\nprint(`how much faster yo ur computations will be! But watch your syntax!`);\nprint(`Use 'usepro duct' to change value of _default_Clifford_product in Cl(B) from`);\np rint(`cmulRS when B is symbolic to cmulNUM when B is numeric. Type ?cm ul for help.`); \nprint(`++++++++This is CLIFFORD version 7, library f ile : Clifford.m++++++++`);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 2. Procedure " }{TEXT 282 17 "specify_constants" }{TEXT -1 503 " allows user to specify any new symbolic constants, e.g., a, b, c , B, e.t.c, which are to be known to Maple. The originally known con stants are stored in a global, non-protected variable 'constants' and \+ must be saved separately, if needed. This procedure is needed when so rting or collecting multivariate Clifford polynomials containing expre ssions like 'aa*eiwej' in which 'aa' is intended to be a constant and \+ 'eiwej' is intended to be a Clifford basis monomial with indices i and j. Before using " }{TEXT 281 7 "clisort" }{TEXT -1 4 " or " }{TEXT 280 10 "clicollect" }{TEXT -1 350 " user should make any additional co nstants of length 2 or more known to Maple as shown below. If these c onstants of length 2 or more are not defined as Maple constants, then \+ some procedures might yield error messages (although an attempt has be en made to avoid this problem). Constants of length one are automatica lly assumed to be Maple constants. " }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: specify_constants(a, b , B, aa); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 186 "NOTE: from now on, extra spaces have been added for the \+ Reader's convenience in the sequence of input variables as in the abov e example. These spaces are not needed or required by Maple." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 371 "specify_ constants:=proc(a1::anything) global constants;\noptions `Copyright (c ) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reser ved.`;\ndescription `Last revised: November 5, 2002`;\n############### ##############################\nconstants:=op(\{constants,args\});\npr intf(\"Maple now knows the following constant(s): %q\\n\",constants); \nreturn NULL;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 21 "No. 3. T he procedure " }{TEXT 283 6 "cbasis" }{TEXT -1 793 " writes a canonica l basis for a Clifford algebra Cl(B) over a vector space V endowed wit h a bilinear form B. The dimension of V is specified by a Maple globa l 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 Clif ford algebra Cl(4). In the second case, it returns a list of basis ele ments in the 2-vector subspace of Cl(4). Below, 'Id' stands for the al gebra unit element and 'w' denotes wedge/exterior product in the Cliff ord algebra. An option 'even' allows one to create a basis in the even subalgebra of the given Clifford algebra as in cbasis(3, 'even'). In fact, 'even' can be replaced with any name which evaluates to a strin g. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1875 "cbasis:=proc(a1::nonneg int,a2::\{string,symbol,nonnegint\})\nlocal i,k,X,XX,YY,L,Leven,Lodd,b as,nxt,ind,start; global choose,e;\noptions `Copyright (c) 1995-2003 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`,remembe r;\ndescription `Last revised: November 5, 2002`;\n################### ##########################\nif a1>9 then \n error \"first argument m ust be between 0 and 9 inclusive but received %1 instead\",a1 \nend if ;\nif a1=0 and nargs=1 then return [Id] end if;\nif nargs=2 and type(a 2,\{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 i f type(length(L[i]),odd) then Leven:=[op(Leven),L[i]] else\n \+ Lodd:=[op(Lodd),L[i]]\n end if \n \+ end do \n end if; \nif args[2]='even' then return Leven \n elif a rgs[2]='odd' then return Lodd\n else error \"second argument must be an integer or a string 'even' or 'odd' but received %1 instead\",args [2]\nend if\nend do \nend if;\nfor k from 0 to a1 do \n X[k]:=combi nat[choose]([seq(i,i=1..a1)],k) \nend do;\nif not nargs = 1 and not na rgs = 2 then \n error \"one or two arguments are needed as input but received %0 instead\",args\nelif nargs = 1 then XX:=[seq(op(X[k]),k=0 ..a1)] \nelse if not a2 >= 0 or not a2 <= a1 then \n error \"second ar gument must satisfy: 0 <= 'a2' <= %1 but received %2 instead\",a1,a2 \+ \nelse XX:=X[a2] \nend if \nend if;\nYY:=array(1..nops(XX),[]);start: =1:\nif XX[1] = [] then \n YY[1]:=Id; \n start:=2 \nend if;\nfor k from start to nops(XX) do\n ind:=XX[k][1];\n if ind=10 then \n \+ bas:=e||0 else bas:=e||ind \n end if;\nfor i from 2 to nops(X X[k]) do \n ind:=XX[k][i]:\n if ind=10 then nxt:=e||0 else nxt:= e||ind end if:\n bas:=cat(bas,\"w\",nxt): \n end do;\nYY[k]:= bas;\nend do:\nYY:=convert(YY,list);\nprotect(op(YY)); #protect basis \+ monomials\nreturn YY\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 17 "N o. 4. Procedure " }{TEXT 284 8 "find1str" }{TEXT -1 327 " finds all lo cations of the first string of length one in the second string of leng th at least one. It returns a set of these positions. If the first st ring is not found then it returns \{0\}. This procedure is primarily f or internal use in 'type/clibasmon' and 'cliparse'. \nTypical use: fin d1str(e,e1we2we3); find1str(w,e1we2);" }{MPLTEXT 0 21 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 662 "find1str:=proc(a1::symbol,a2::symbol) lo cal ns,p,p1,ap,le2;\nglobal _prolevel;\noptions `Copyright (c) 1995-20 03 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`,rem ember;\ndescription `Last revised: November 5, 2002`;\n############### ##############################\nle2:=length(a2):\nif _prolevel=false t hen\nif length(a1) <> 1 or le2<1 then \n error \"first string must b e of length 1 but received %1 instead\",a1 \nend if;\nend if;\np:=Sea rchText(a1,a2):\nap:=\{p\}:p1:=p:\nwhile p<>0 and p10 then p1 :=p1+p;\n ap:=ap union \{p1\} \n end if;\nend do;\nre turn ap\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 5. Function " }{TEXT 285 8 "cliparse" }{TEXT -1 349 " checks user's input for cor rect spelling of basis monomials. When unable to decide if the given \+ input is correct, it tells the user to check spelling or define the gi ven string as a Maple constant. If the spelling is correct, it returns true; if it is not correct, it returns a set of suspect words.\n \nTy pical use: cliparse(e1+e2we3+2*Pi*B[1,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1179 "cliparse:=proc(a1::anything) local x,S1,S2,p,S;\ngl obal _prolevel,_scalartypes;\noptions `Copyright (c) 1995-2003 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n################################## ###########\nif _prolevel then return true end if;\nif type(a1,_scalar types) 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,cli basmon) then S1:=S1 minus \{x\} end if;\nend do; \nS2:=map(op,S1); \nf or 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(exp and(p))\}),\{op(_scalartypes),clibasmon\});\nfor x in S do \n if fi nd1str(e,x)=\{0\} and x<>'Id' then S:=S minus \{x\} end if;\nend do;\n if S=\{\} then return true end if;\nS1:=select(type,S,procedure):\nif \+ S1 <> \{\} then\n error \"procedure name %1 that has been found in i nput is not allowed as a symbolic coefficient\",op(S1)\nend if;\nif no ps(S)=1 then \n error \"check spelling of %1 or define it as a const ant or an alias\",op(S)\nelse \n error \"check spelling of %1 or def ine them as constants or aliases\",op(S) \nend if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 16 "No. 6. Function " }{TEXT 286 9 "display id" }{TEXT -1 186 " replaces a user-entered Clifford scalar with the s calar 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 621 "displayid:=proc(a1::\{array,matr ix,algebraic\}) local KK,p;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: November 5, 2002`;\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 retur n map(procname,a1) end if;\np:=expand(a1):\nif type(p,\{`*`,cliscalar, clibasmon,climon\}) then return KK(p) \nelif type(p,\{`+`\}) then retu rn map(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 poly nomial.\n\nNOTE: 'cliterms' also works with terms of type cliprod and \+ it finds correctly terms involving such expressions. \n\nTypical use: \+ cliterms(2*Pi+2*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1019 "clit erms:= proc(a1::anything) local S1,S2,S3,x,p,Cliplusflag;\noptions `Co pyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: November 5, 2002`;\n##### ########################################\nCliplusflag:=assigned(Cliplu s):\nif hastype(a1,cliprod) and not Cliplusflag and _warnings_flag the n \n WARNING(`argument to 'cliterms' contains type cliprod. Load 'Cl iplus' to extend functionality of CLIFFORD. Type ?cliprod for help.`) \nend if;\nif type(a1,\{clibasmon,cliprod\}) then return \{a1\} end if ;\np:=displayid(simplify(a1)):\nif hastype(p,cliprod) then \n S1:=re move(type,\{op(p)\},cliscalar);\n S2:=select(hastype,S1,\{clibasmon, climon,cliprod\});\n S3:=\{\}:\n while not S2=\{\} do\n S3 :=S3 union select(type,S2,\{clibasmon,cliprod\});\n S2:=select (hastype,map(op,remove(type,S2,\{clibasmon,cliprod\})),\{clibasmon,cli prod\});\n end do;\nreturn S3\nend if;\nx:='x':\nS1:=remove(type,\{o p(p)\},cliscalar);\nreturn \{seq(select(hastype,x,clibasmon),x=S1)\}\n end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 8. Procedure " } {TEXT 288 11 "clibilinear" }{TEXT -1 360 " makes any procedure K speci fied as the third argument bilinear with respect to Clifford scalars i n the first two arguments. The first two arguments are of the type cli polynom, i.e., Clifford polynomials. The third argument is a string or a procedure.\nIt can handle terms involving elements of type cliprod. \n\nTypical use: clibilinear(e1+2*e2we3,Id+2*e2+e3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 922 "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-2003 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n######################################## #####\nif simplify(a1)=0 or simplify(a2)=0 then return 0 end if; \np1: =clicollect(a1):\np2:=clicollect(a2):\n tail:=args[4..-1];\n if type (p1,\{climon,cliprod\}) then S1:=[p1] else S1:=[op(p1)] end if:\n if \+ type(p2,\{climon,cliprod\}) then S2:=[p2] else S2:=[op(p2)] end if:\n \+ S12:=[seq(seq([x,y],x=S1),y=S2)];#this list will be huge for long pol ynomials\n res:=0:\n for x in S12 do \n cli1:=select(type,x[1],\{ cliprod,clibasmon\}):\n cli2:=select(type,x[2],\{cliprod,clibasmon \}):\n co1:=coeff(x[1],cli1):\n co2:=coeff(x[2],cli2):\n res: =res+co1*co2*a3(cli1,cli2,tail):\n end do:\n 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 seco nd argument linear with respect to Clifford scalars (elements of type \+ cliscalar). It can now distribute over Clifford polynomials with eleme nts of `type/cliprod`. Any additional parameters are passed on to the \+ procedure entered as the second argument.\nTypical use: clilinear(a*e1 +2*e2we3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 621 "clilinear:=proc( a1::\{symbol,cliscalar,clibasmon,climon,clipolynom\},a2::\{name,proced ure\}) \nlocal tail,p1,S1,res,x,cli1,co1;\noptions `Copyright (c) 1995 -2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: November 5, 2002`;\n##################### ########################\ntail:=args[3..-1];\nif type(a1,cliscalar) th en return a1*a2(Id,tail) end if;\np1:=displayid(a1):\nif type(p1,climo n) 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,cl i1); \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 "cli sort" }{TEXT -1 312 " sorts the given multivariate Clifford polynomial with respect to the Clifford indetereminates found in the expression \+ via the procedure 'cliterms'. It puts scalar coefficients of the type \+ cliscalar in front of the Clifford basis monomials. It may also be app lied to matrices with entries in a Clifford algebra. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 40 "Typical use: cliso rt(2*e1we2 - e1*b); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 427 "clisort :=proc(p::algebraic) local L,N;\noptions `Copyright (c) 1995-2003 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: November 5, 2002`;\n############################### ##############\nif type(p,matrix) then return map(procname,p) end if; \nif type(p,\{climon,clipolynom\}) or hastype(p,cliprod) then\n L:=c literms(expand(displayid(p)));\n return sort(p,L);\nend if:\nreturn \+ p\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 11. Procedure " }{TEXT 291 10 "clicollect" }{TEXT -1 382 " reorders monomial terms in \+ standard order and then collects them in a multivariate Clifford polyn omial. It may also be applied to matrices with entries in a Clifford a lgebra. It will simplify 6 + 7*Id to 13*Id. It collects now terms of \+ type cliprod, if present.\n\nNOTE: 'clicollect' also works with terms \+ of type cliprod and it collects correctly terms involving such express ions. " }}{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 496 "clicollect:=proc(a1::algebraic) local p,L; \n options `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: November 5, 20 02`;\n#############################################\nif type(a1,matrix ) then return map(procname,a1) end if;\np:=expand(a1):\nif type(p,clis calar) then return p*Id\nelif type(p,clipolynom) then \n L:=cliter ms(p);\n return map(simplify,collect(displayid(p),L,'distributed') )\nelse 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 " returns an ordered list of positions in a monomial, e.g., e1we2 , where vector indices are found. Then, nops(ord(e1we2)) can be used to find the order of the monomial. Note that for consistency we have ord(Id) = ord(numeric) = ord(numeric*Id) = ord(cliscalar)=[] where cl iscalar is any object of the type cliscalar." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 35 "This procedure is for i nternal use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 386 "ord:=proc(a1) local v,k;\noptions `Copyright (c) 199 5-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.` ;\ndescription `Last revised: November 5, 2002`;\n#################### #########################\nif type(a1,cliscalar) then return [] end if ;\nv:=select(type,a1,clibasmon);\nif v = Id then return [] end if;\nk: ='k':\nreturn [seq(2+3*k,k=0..((length(v)+1)/3-1))]\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 19 "No. 13. Procedure " }{TEXT 293 9 "clir emove" }{TEXT -1 193 " removes one symbol 'ei' from the location speci fied by the procedure 'ord'. \n(NOTE: procedure 'ord' specifies locati on of the index 'i' in 'ei'.) This procedure is primarily for interna l use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 578 "cliremove:=proc(p::posint,s::symbol) local S1,S2;global _prol evel;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`,remember;\ndescription `Last revised : November 5, 2002`;\n#############################################\ni f not _prolevel then\n if s=Id then error \"second argument must be \+ Grassmann basis monomial of rank >= 1\" end if;\nend if;\nS2:=substrin g(s,(p+2)..length(s));\nS1:=substring(s,1..(p-3));\nif length(S2)=0 an d S1 <> s then return S1 \n elif S1 = s then return S2 \n else ret urn cat(S1,\"w\",S2); \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. Procedure " }{TEXT 294 7 "extract" }{TEXT -1 445 " extracts indices of a monomial (or a constant times a monomial) and \+ it returns them as a list of strings. If necessary, they can be retur ned as a list of integers if option 'integers' is selected (in fact, a ny name which evaluates to a string may be used as the option). Indic es could be now integers, letters, or they could be mixed. Note that e xtract(Id) = [] and extract(numeric) = extract(numeric*Id) = [] resul ts in no vector indices. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 63 "Typical use: extract(2*e1we2); or extract(e2w e3, \"integers\"); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 780 "extract:=proc(a1::\{symbol,cliscalar,clibasmon, climon\},a2::symbol) \nlocal v,k,inds;global _prolevel,str_to_int;\nop tions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`,remember;\ndescription `Last revised: Novembe r 5, 2002`;\n#############################################\nif type(a1 ,cliscalar) or (type(a1,symbol) and length(a1)=1) then return [] \neli f\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 [] end if;\nk:='k':\ninds:=[seq(substring(v,(2+3*k)..(2+3*k)),k =0..((length(v)+1)/3-1))];\nif nargs=1 then return inds \n elif type (a2,symbol) then return map(convert,inds,str_to_int)\n else error \" wrong option or number of arguments\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 15. Procedure " }{TEXT 295 7 "reorder" } {TEXT -1 330 " reorders Clifford monomials in the given Clifford polyn omial using standard ordering and calculates sign of each permutation, e.g., reorder(e1we3we2) = -e1we2we3, reorder(e2we1 + 2*e1we5we2) = -e 1we2 - 2*e1we2we5. If any one of the indices of the monomial is a lett er, e.g., reorder(eiwe3) = eiwe3, reorder returns its argument. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 139 "Reor der now can order monomials and polynomials with symbolic coefficients , e.g. reorder(ejwei) = -eiwej, using the lexicographic order. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typic al use: reorder(e2we1 + 2*Id + e4we3we1); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1075 "reorder:=proc(a1::algeb raic) \n local L1,L2,N,newbas,f,a,x,K,dummy_set,n12,s12,ss;\n \+ global B,dim_V;\noptions `Copyright (c) 1995-2003 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: November 5, 2002`;\n####################################### ######\nif type(a1,\{matrix,`+`,`*`\}) then return map(procname,a1) en d if; \nL1:=Clifford:-extract(a1);\nN:=nops(L1);\nif N>9 then error \" detected basis monomial of grade higher than 9 in the input\" end if; \nif N=0 or N=1 then return a1 end if;\nn12,s12:=selectremove(member,L 1,\{`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(s1 2))];\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 "maxi ndex" }{TEXT -1 226 " which finds the greatest index in the given Clif ford polynomial or in the given list or set of Clifford monomials. It \+ returns 0 for a Clifford scalar (an element of type cliscalar).\n\nTyp ical use: maxindex(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 812 "maxindex:=proc(a1::\{cliscalar,clibasmon,climon,clip olynom,list,set\}) \nlocal inds,mons,symbinds;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: November 5, 2002`;\n################ #############################\nif type(a1,cliscalar) or a1=Id then ret urn 0 elif\n type(a1,list) then return max(op(convert(map(procname,a 1),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,m ons,'integers'));\n symbinds:=remove(type,inds,integer);\n if symb inds = \{\} then\n if inds=\{\} then return 0 else return max(op( inds)) end if;\n else\n error \"cannot determine maximum index \+ because input contains symbolic index or indices\"\n end if;\n end \+ if;\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 grade in the given Clifford polynomial. It returns 0 for \+ a Clifford scalar (an element of type cliscalar).\n\nTypical use: maxg rade(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 399 "maxg rade:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local S;\nop tions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`;\ndescription `Last revised: November 5, 2002 `;\n#############################################\nif type(eval(a1),cl iscalar) then return 0 end if;\nS:=\{op(cliterms(eval(a1)))\}:\nreturn max(op(map(nops,map(Clifford:-extract,S))))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 18. Procedure " }{TEXT 298 2 "LC" } {TEXT -1 233 " defines a left contraction between any multivector u an d a multivector v, i.e., multivector u acts on the multivector v from \+ the left. This procedure is now bilinear in both arguments. It can a ccept 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 2276 "LC:=proc(x::\{cl iscalar,clibasmon,climon,clipolynom\},\n y::\{cliscalar,clibas mon,climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,lname, res,coB,nameB;\n global _CLIENV,B;\noptions `Copyright (c) 1995-200 3 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: November 5, 2002`;\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,matr ix,array\})) then\n coB:=op(select(type,\{op(args[3])\},numeric) );\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n ln ame:=args[3]:\n else \n error \"wrong type of third argument \+ in LC. See ?LC for more help.\" \n end if;\nelse\n error \"two or three arguments expected in LC. See ?LC for more help.\"\n end if;\n# ###############################\n if type(x,clibasmon) then\n if t ype(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:=\nprocname(makeclibasm on(lst1[1..-2]),procname(makeclibasmon([lst1[-1]]),y,lname),lname);\n \+ return reorder(res)\n end if;\n elif type(y,climon) \+ then\n term,cf:=selectremove(type,y,clibasmon);\n return \+ expand(cf*procname(x,term,lname))\n elif type(y,clipolynom) then \n return add(procname(x,i,lname),i=[op(y)])\n elif type( y,cliscalar) then \n return displayid(scalarpart(x)*y)\n e nd if; \n elif type(x,climon) then\n term,cf:=selectremove(type,x ,clibasmon);\n return expand(cf*procname(term,y,lname))\n elif typ e(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;\ner ror \"Got input %1 and %2 but LC can only process constants and Cliffo rd numbers\",x,y;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 1 9. Procedure " }{TEXT 299 3 "LCQ" }{TEXT -1 270 " is a special version of 'LC' and gives left contraction in the orthogonal Clifford algebra Cl(Q) of the quadratic form Q defined via the symmetric part g of B a s Q(x) = g(x, x) = B(x, x). It can accept name as a third optional ar gument or a numeric multiple of a name." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 76 "Proposed by Yvon Siret, Universi te Joseph Fourier, Grenoble, France. Thanks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 82 "Typical use: LCQ(e1 + 2 *e2, e1we3 + b*e2we3);\nLCQ(e1 + 2*e2, e1we3 + b*e2we3,K); \n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1794 "LCQ:=proc(x::\{cliscalar,clibasmo n,climon,clipolynom\},\n y::\{cliscalar,clibasmon,climon,clip olynom\}) \n local ii,N,L,m,Sxy,symbxy,lname,coB,nameB;global B:\n options `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: November 5, 20 02`;\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(selec t(type,\{op(args[3])\},numeric));\n nameB:=op(remove(type,\{op(a rgs[3])\},numeric));\n lname:=args[3]:\n else \n error \+ \"wrong type of third argument in LCQ. See ?LCQ for more help.\" \n \+ end if;\nelse\n error \"two or three arguments expected in LCQ. See ?LCQ for more help.\"\nend if;\n################################\nSxy :=remove(type,map(op,\{op(x),op(y)\}),cliscalar);\nSxy:=map(op,map(Cli fford:-extract,Sxy,'integers'));\nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n return LC(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 bilinear f orm %1\",lname \n end if;\nend if:\nif type(lname,\{name,symbol,arra y,matrix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n return LC(x,y,l inalg[diag](L))\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 LC(x,y,linalg[diag](L)) \n end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 20. Pro cedure " }{TEXT 300 2 "RC" }{TEXT -1 241 " defines a right contraction between any multivector u and a multivector v, i.e., multivector u ac ts on the multivector v from the right. This procedure is now bilinea r 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 "T ypical use: RC(e1 + 2*e2, e1we3 + b*e2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2279 "RC:=proc(x::\{cliscalar,clibasmon,climon,clipolynom \},\n y::\{cliscalar,clibasmon,climon,clipolynom\})\n local N 1,N2,lst1,lst2,i,j,cf,term,lname,res,coB,nameB;\n global _CLIENV,B;\n options `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: November 5, 20 02`;\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(selec t(type,\{op(args[3])\},numeric));\n nameB:=op(remove(type,\{op(a rgs[3])\},numeric));\n lname:=args[3]:\n else \n error \+ \"wrong type of third argument in RC. See ?RC for more help.\" \n e nd if;\nelse\n error \"two or three arguments expected in RC. See ?R C for more help.\"\nend if;\n################################\n if ty pe(x,clibasmon) then\n if type(y,clibasmon) then\n lst1:=Cliff ord:-extract(x,'integers');\n lst2:=Clifford:-extract(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 if N2=1 then \n \+ res:=`+`(seq(coB*nameB[lst1[-i],lst2[1]]*_CLIENV[_QDEF_PREFACT OR]^(i-1)*\n makeclibasmon([op(subs(lst1[-i]=NULL,l st1))]),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 return expand(cf* procname(x,term,lname))\n elif type(y,clipolynom) then\n retur n add(procname(x,i,lname),i=[op(y)])\n elif type(y,cliscalar) then \+ return reorder(x)*y \n end if;\n elif type(x,climon) then\n te rm,cf:=selectremove(type,x,clibasmon);\n return expand(cf*procname( term,y,lname))\n elif type(x,clipolynom) then\n return add(procnam e(i,y,lname),i=[op(x)])\n elif type(x,cliscalar) then \n return di splayid(x*scalarpart(y))\n end if;\nerror \"Got input %1 and %2 but \+ can only process constants and Clifford numbers\",x,y\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 259 18 "No. 21. Procedure " }{TEXT 301 3 "RCQ" } {TEXT 302 85 ": Right contraction in Cl(Q). It can accept third option al argument such as K or -K.\n" }{TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1799 "RCQ:=proc(x::\{cliscalar,clibasmon,climon,clipolyno m\},\n y::\{cliscalar,clibasmon,climon,clipolynom\}) \n l ocal ii,N,L,m,Sxy,symbxy,lname,coB,nameB;global B:\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: November 5, 2002`;\n############ ################################# \nif nargs=2 then\n coB:=1:\n \+ nameB:=`B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3 ],\{name,symbol,matrix,array\}) then\n coB:=1:\n nameB:=ar gs[3];\n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{n ame,symbol,matrix,array\})) then\n coB:=op(select(type,\{op(args [3])\},numeric));\n nameB:=op(remove(type,\{op(args[3])\},numeri c));\n lname:=args[3]:\n else \n error \"wrong type of \+ third argument in RCQ. See ?RCQ for more help.\" \n end if;\nelse\n error \"two or three arguments expected in RCQ. See ?RCQ for more h elp.\"\nend if;\n################################\nSxy:=remove(type,ma p(op,\{op(x),op(y)\}),cliscalar);\nSxy:=map(op,map(Clifford:-extract,S xy,'integers'));\nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} \+ then \n return RC(x,y,lname) \nend if;\nm:=max(op(Sxy),1);# 1 is nee ded when both x and y have maxindex=0\nif type(evalm(lname),matrix) th en \n N:=linalg[coldim](evalm(lname)):\n if m>N then \n e rror \"input contains index larger than size of bilinear form %1\",lna me \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,array,matrix\})) \+ then\n coB:=op(select(type,\{op(lname)\},numeric));\n nameB:=op(se lect(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;\n end proc:" }}{PARA 258 "" 0 "" {TEXT -1 19 "\nNo. 22. Procedure " } {TEXT 303 8 "gradeinv" }{TEXT -1 133 " is the grade involution in the \+ Clifford algebra,i.e., it reverses signs of odd elements and leaves si gns of even elements unchanged." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 48 "Typical use: gradeinv(e1 + e1we2 - 4*e3 we4); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 552 "gradeinv:=proc(a1:: \{matrix,cliscalar,clibasmon,climon,clipolynom\}) global _CLIENV;\nopt ions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser . All rights reserved.`;\ndescription `Last revised: November 5, 2002` ;\n#############################################\nif type(a1,matrix) t hen return map(procname,a1) end if;\n#if not assigned(_CLIENV) then _C LIENV[_QDEF_PREFACTOR]:=-1 end if;\nif type(a1,clibasmon) then return (_CLIENV[_QDEF_PREFACTOR])^maxgrade(a1)*a1 \n el se return clilinear(a1,procname) \nend if;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 19 "No. 23. Define the " }{TEXT 304 5 "wedge" }{TEXT -1 1306 " product of any number of Clifford polynomials. The infix fo rm of this associative multiplication is `&w`. Thus, e1 &w e2 = wedge (e1, e2), etc. Via the procedure 'rmulm' described below, wedge multi plication may be applied to matrices with entries in a Clifford algebr a or in an exterior algebra.\n\nNew feature: When the dimension of the vector space is known, either from the size of the matrix B or from t he global parameter dim_V that can be set by the user, the output of t he procedure does not include terms of grade higher than the dimension of the vector space in case symbolic indices are used. \n\nThe defaul t value of this global variable is 9 and it it set by the initializati on file when Clifford is loaded.\n\nWhen the procedure is invoked, it \+ checks whether the bilinear form B has been defined. If yes, the proce dure checks whether the size of B is less than the current value of di m_V. If again yes, a warning message is issued by the procedure and th e value of dim_V is reduced. If the size of B is larger than the curre nt value of dim_V, no warning message is issued and the value of dim_ V is increased to linalg[coldim](B).\n\nThe warning message can be sup ressed by addign 'false' to a global parameter _warnings_flag whose de fault value is set to true by the Clifford initialization file." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 96 "Typic al 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 3061 "wedge:= proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n a2:: \{cliscalar,clibasmon,climon,clipolynom\}) \nlocal ii,kk,wedge2,pi,p1, p2,i1,i2,i12,n12,maxindexflag,expr,maxin;\nglobal dim_V,B,_warnings_fl ag;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: November \+ 5, 2002`;\n#############################################\nkk:='kk':\ni f member(0,[args]) then return 0 \nelif \n remove(type,\{args\},clis calar)=\{\} then return product(args[kk],kk=1..nargs)\nend if;\nif typ e(B,matrix) then\n if linalg[coldim](B)<>dim_V then \n if linal g[coldim](B) < dim_V then\n dim_V:=linalg[coldim](B);\n \+ if _warnings_flag then\nprintf(\"Warning, since B has been (re-)assi gned, value of dim_V has been reduced by 'wedge' to %g\\n\",dim_V);\n \+ end if;\n elif linalg[coldim](B)>dim_V then\n dim_V:=li nalg[coldim](B);\n end if;\n end if;\n end if; \nif not type(d im_V,Range(0,10)) or \n not type(dim_V,posint) then\n error \"valu e of dim_V must be a positive integer between 1 and 9, inclusive, but \+ current value of dim_V is %1\",dim_V\nend if;\n################\ni12:= \{\}:\nfor ii from 1 to nargs do\n pi:=args[ii]: \n i12:=i12 uni on map(op,map(Clifford:-extract,cliterms(pi),'integers')):\nend do;\nn 12:= select(member,i12,\{1,2,3,4,5,6,7,8,9\}):\nif not n12=\{\} then\n maxin:=max(op(n12)); \n maxindexflag:=evalb(maxin > dim_V);\nelse maxindexflag:=false:\nend if:\nif maxindexflag then \n error \"argu ment(s) contain(s) index larger then current value of dim_V which is n ow %1. To complete computation, increase value of dim_V or assign squa re matrix of size at least %2 by %3 to bilinear form B\",dim_V,maxin,m axin\nend if;\n################\nwedge2:=proc() local expr,i1,i2,n1,n2 ,i12,s12,symbindexflag;global dim_V;\n i1:=\{op(Clifford:-extract(args [1]))\};n1:=nops(i1):\n i2:=\{op(Clifford:-extract(args[2]))\};n2:=nop s(i2):\n if args[1]=Id then \n if n2>dim_V then return 0 else retur n args[2] end if;\n end if;\n if args[2]=Id then \n if n1>dim_V the n return 0 else return args[1] end if;\n end if;\n i1:=\{op(Clifford :-extract(args[1]))\};\n i2:=\{op(Clifford:-extract(args[2]))\};\n \+ i12:=i1 union i2;\n s12:= remove(member,i12,\{`1`,`2`,`3`,`4`,`5`,` 6`,`7`,`8`,`9`\}):\n symbindexflag:=evalb(not s12=\{\}):\n if i1 i ntersect i2 <> \{\} then return 0 end if;\n if symbindexflag and nop s(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 retu rn args\nelif nargs=2 then p1:=displayid(a1):\n p2:=d isplayid(a2):\n expr:=clibilinear(p1,p2,wedge2);\n \+ if hastype(expr,trig) then \n retur n clicollect(map(combine,clicollect(expr),trig))\n el se \n return reorder(expr)\n end \+ if;\nelse expr:=procname(procname(a1,a2),args[3..nargs]):\n if has type(expr,trig) then \n return clicollect(map(combine,clicollec t(expr),trig))\n else \n return reorder(expr)\n end if; \nend if;\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 269 29 "No. 24. Ampers and version of " }{TEXT 307 5 "wedge" }{TEXT 308 38 ". (Has been moved to Clifford:-setup)\n" }}{PARA 0 "" 0 "" {TEXT 260 18 "No. 25. Proced ure " }{TEXT 305 8 "permsign" }{TEXT 306 118 " computes sign of a perm utation that sorts a list of indices.\n\nTypical use: permsign([1,3,2] ); permsign([j,1,i,k,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 880 "per msign:=proc(L::list) local newbas,ss,a,n12,s12,L1,L2,N,f,dummy_set,K,x ;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n#############################################\nL1:=L:\nN:=nop s(L1):\nif N=1 then return 1 end if:\n################## new\nn12,s12: =selectremove(member,L1,\{1,2,3,4,5,6,7,8,9\});\n#s12:=remove(member,L 1,\{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:\nwhile dummy_ set <> \{\} do\n a:=dummy_set[1]:\n dummy_set:=dummy_set[2..-1];\n \+ x:=a:\n while f(x)<>a do\n x:=f(x);\n dummy_set:=dummy_set \+ minus \{x\};\n K:=K+1;\n end do:\nend do;\n#newbas:=cat(e.(op(L2 [1..-2])).w,e,L2[-1]):\n#return ((-1)^K*newbas);\nreturn (-1)^K;\nend \+ proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 26. Procedure " }{TEXT 309 7 "cmulNUM" }{TEXT -1 148 " calculates Clifford product between an y two Clifford monomials using the recursivelyChevalley's definition o f 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 "wher e 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 biline ar in both arguments. The infix form is available e.g., e1 &c e2. Th is procedure works in Clifford algebras in dimensions up to and includ ing 9. Multiplication of matrices with entries in a Clifford algebra \+ can be done with a procedure 'rmulm' described below." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 128 "This procedure requ ires third argument of type name or a numeric multiple of a name. Then it computes Clifford product in Cl(K)." }}{PARA 258 "" 0 "" {TEXT -1 221 "\nThis version can take index as a way of passing a parameter. T he index could be of type `&*`(numeric,\{name,symbol,array,matrix\}) o r of type \{name,symbol,array,matrix\}.\n\nWhen the bilinear form B i s symbolic, use cmulRS." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 " " 0 "" {TEXT 264 55 "Typical use: cmulNUM(e1,e3we4,B); cmulNUM(e1,e3we 4,-K);" }{TEXT 265 3 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2253 "cmu lNUM:=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-2003 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\n description \+ `Last revised: November 5, 2002`;\n################################### ##########\n###This is additional code for Maple 6 version:\n######### ####################################\nif hastype(\{a1,a2\},cliprod) th en\n a12:=map(Cliplus:-clieval,[a1,a2]);\n return Cliplus:-cliexpa nd(clibilinear(a12[1],a12[2],procname,lname))\nend if: \n############# ###################################################################### ###\n### old name cmul2B: this procedure computes recursively Clifford product of any two #\n### cliscalars, clibasmons, climons, and clipol ynoms in Clifford algebras Cl(lname) #\n############################# #########################################################\n if nargs< >3 then error \"exactly three arguments are needed\" end if:\n if has (0,map(simplify,[a1,a2])) then return 0 end if;\n if a2=`Id` then ret urn a1 end if:\n if a1=`Id` then return a2 end if:\n L:=Clifford:-ex tract(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 unexp ected type\"\n end if;\n ################\n if N=0 then return coef f(a1,Id)*a2\n elif N=1 then\n L2:=Clifford:-extract(a2,'integers') :\n return reorder(simplify(makeclibasmon([L[1],op(L2)])\n +add ((-1)^(i-1)*coB*nameB[L[1],L2[i]]*makeclibasmon(subs(L2[i]=NULL,L2)),i =1..nops(L2))))\n elif N=2 then\n x1:=substring(a1,1..2):x2:=subst ring(a1,4..5);\n p2:=procname(x2,a2,lname):\n S:=clibilinear(x1, p2,procname,lname);\n return simplify(S-coB*nameB[op(L)]*a2)\n end if;\n x:=cat(e,L[-1]);\n p1:=substring(a1,1..(3*N-4));\n p2:=procn ame(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]=NUL L,L[1..-2])),a2,lname),i=2..N); \n return reorder(simplify(S))\nend p roc:\n" }}{PARA 0 "" 0 "" {TEXT 266 19 "No. 27. Procedure " }{TEXT 310 6 "cmulRS" }{TEXT 311 114 " computes Clifford product using Rota-S tein cliffordization technique. It can accept now -K in place of the n ame.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4902 "cmulRS:=proc(a1,a2,lnam e)\nlocal max_grade,L1,N1,L2,N2,genPS,fun1,fun2,srt,cup,pList1,PN1,\n \+ pList2,PN2,pSgn1,pSgn2,a,i,j,m,n,res,pos1,pos2,F1,F2,coB,nameB,a1 2;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5 , 2002`;\n#############################################\n###This is ad ditional code for Maple 6 version:\n################################## ###########\nif hastype(\{a1,a2\},cliprod) then\n a12:=map(Cliplus:- clieval,[a1,a2]);\n return Cliplus:-cliexpand(clibilinear(a12[1],a12 [2],procname,lname))\nend if: \n###################################### ####################################################\n### This procedu re computes Clifford product of any two cliscalars, clibasmons, climon s, #\n### and clipolynoms in Clifford algebras Cl(lname) using Rota-St en cliffordization #\n### Procedure cmulRS modified by Rafal to \+ accept -K, or -B for lname. #\n#################### ###################################################################### \n if nargs<>3 then error \"exactly three arguments are needed\" end \+ if:\n if has(0,map(simplify,[a1,a2])) then return 0 end if;\n if a1 \+ = `Id` then return a2 end if;\n if a2 = `Id` then return a1 end if;\n ################\n ##### The following will allow for lname to be - B, for example:\n if type(lname,\{name,symbol,array,matrix\}) then\n \+ coB,nameB:=1,lname:\n elif type(lname,`&*`(numeric,\{name,symbol, array,matrix\})) then\n coB:=op(select(type,\{op(lname)\},numeric) );\n nameB:=op(select(type,\{op(lname)\},name));\n else\n err or \"third argument is of unexpected type\"\n end if;\n ############ ####\n L1:=Clifford:-extract(a1,'integers');\n N1:=nops(L1);\n L2:= Clifford:-extract(a2,'integers');\n N2:=nops(L2);\n if N1=1 then \n \+ return reorder(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(makecl ibasmon([op(L1),L2[1]])\n +add((-1)^(i-1)*coB*nameB[L1[-i],L2[1]]*m akeclibasmon(subs(L1[-i]=NULL,L1)),i=1..N1)))\n end if;\n#### genPS ; 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 p lst:=[a]:\n for i in a do\n plst:=[op(subs(i=NULL,plst)),op(pl st)]:\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:=[se q(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:=genPS( N1); \n PN1:=nops(pList1)+1; ## added 1 here\n pList1:=sort(pList1 ,(a,b)->evalb(nops(a)<=nops(b)));\n pSgn1 :=[seq((-1)^(add(pList1[i][ m]-m,m=1..nops(pList1[i]))),i=1..PN1-1)];\n#### prepare combinatorics \+ for L2:\n fun2:=proc(a2) a2 end proc:\n for i from 1 to N2 do\n f un2(i):=L2[i];\n end do:\n#### here is the old code for the poweset \+ \n# a:=[seq(i,i=1..N2)]:\n# pList2:=[a]:\n# for i in a do\n# pLi st2 := [op(subs(i = NULL,pList2)), op(pList2)]:\n# end do:\n####\npLi st2:=genPS(N2);\n PN2:=nops(pList2)+1; ## added 1 here\n pList2:=so rt(pList2,(a,b)->evalb(nops(a)<=nops(b)));\n pSgn2:=[seq((-1)^(add(pL ist2[i][m]-m,m=1..nops(pList2[i]))),i=1..PN2-1)];\n#### cup tangle of \+ the rota-stein sausage tangle\n cup:=proc(lst1,lst2,coB,nameB)\n l ocal i;\n if nops(lst1)<>nops(lst2) then return 0 end if;\n if l st1=[] then return 1 end if;\n if nops(lst1)=1 then return coB*name B[lst1[1],lst2[1]] end if;\n add((-1)^(i-1)*coB*nameB[lst1[-1],lst2 [i]]*cup(lst1[1..-2],subs(lst2[i]=NULL,lst2),coB,nameB)\n \+ ,i=1..nops(lst2))\n \+ end proc:\n########################################################### ######################## \n## Rota-Stein Tangle : cliffordization \+ #\n## compose only such terms which are potentially non zero in the cup(..) tangle #\n############# ###################################################################### \n max_grade:=nops(\{op(L1),op(L2)\}); ## <== new code\n res:=0:\n \+ pos1:=0:\n for j from 0 to N1 do # for all j-vectors of pList1\n F 1:=N1!/((N1-j)!*j!);\n pos2:=0:\n for i from 0 to min(N2,max_grade-j ) do # for all i-vectors of pList2\n \+ # which do not exceed max_grade (others are zero)\n F2:=N2!/ ((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[PN2- pos2-m]))])\n end do:\n end do:\n pos2:=pos2+F2;\n end \+ do:\n pos1:=pos1+F1;\n end do: \nreturn reorder(res); ## note that cmulRS INCLUDES 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 557 "cmulgen:=proc() global _default_ Clifford_product,_warnings_flag;\noptions `Copyright (c) 1995-2003 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: November 5, 2002`;\n############################## ###############\nif _default_Clifford_product <> 'cmulgen' then\n re turn _default_Clifford_product(args)\nelse \n if _warnings_flag then \n WARNING(\"to assign Clifford product, execute 'useproduct' with a rgument 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 1378 " cmul:=proc() local lname;\noptions `Copyright (c) 1995-2003 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: November 5, 2002`;\n##################################### ########\n if type(op(procname),procedure) then\n lname:=`B`;\n e lse\n lname:=op(procname);\n end if;\n if member(0,[args]) then \+ return 0 end if;\n if nargs <=1 then return args end if;\n if nargs \+ = 2 then\n##########################################################\n ### Speed-wise it makes no difference whether cmulgen or #\n### _defau lt_Clifford_product is used in the following. # ##################### #####################################\n return clicollect(clibilinear (eval(args[1]),eval(args[2]),cmulgen,lname)); \n end if;\n###### <=== do NOT use 'procname' in the next line this will not work\n########## ################################################\n### Speed-wise it ma kes no difference whether cmulgen or #\n### _default_Clifford_product \+ is used in the following. # ######################################### #################\nif not type(_default_Clifford_product,procedure) th en \n error \"global variable _default_Clifford_product must be assi gned a procedure so that 'cmul' could proceed beyond this point. Sorry . For help see ?cmul.\" \nend if;\n return procname(clibilinear(ev al(args[1]),eval(args[2]),cmulgen,lname),args[3..-1]); \nend p roc:\n" }}{PARA 0 "" 0 "" {TEXT 270 29 "No. 30: Ampersand version of \+ " }{TEXT 316 4 "cmul" }{TEXT 317 226 ". This version of `&c` correctly uses -K for index. When K has been assigned a matrix, use\n&c[''K'']( e1,e2) and &c[''-K''](e1,e2). Otherwise, use &c[K](e1,e2), &c[-K](e1,e 2), or &c(e1,e2). (Has been moved to Clifford:-setup).\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2304 "`&m`:=proc() local NP,ARGS,coB,nameB,lname, decindex,flagdec;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: November 5, 2002`;\n############################################# \n#######################################\n### Works when &c[''K''] or &c[''-K''] is entered and K is a matrix\n############################ ###########\nflagdec:=true:\nif type(op(procname),procedure) then\n \+ if type([args],listlist) then\n if type(op(args),array) then\n \+ WARNING(\"enclose index in double quotes as in &c[''B''] or &c[' '-B''] when B has been assigned a matrix to avoid the following:\");\n return 'procname(args)';\n end if;\n else coB:=1:\n \+ nameB:=`B`:\n lname:=`B`:\n ARGS:=[args]:\n flagde c:=false:\n end if;\nelse lname:=op(procname);\n ARGS:=[args];\n if type(lname,`&*`(numeric,name)) then\n coB:=op(select(t ype,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(lnam e)\},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 typ e([args],listlist) then\n if type(op(args),function) then\n ARG S:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op(args)));\n \+ if type(nameB,`&*`(numeric,name)) then\n coB:=op(select(t ype,\{op(nameB)\},numeric));\n nameB:=op(select(type,\{op(name B)\},name));\n end if;\n elif type(op(args),`&*`(numeric,funct ion)) 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 \"u nable to determine index or wrong index, use name in double quotes as \+ in &c[''B''] or &c[''-B'']\"\n end if;\nelif\n type([args],list) \+ then\n ARGS:=args;\n coB:=1:\n nameB:=`B`; #default name \nelse \n error \"cannot determine arguments and/or index from arguments\" \n end if;\nreturn 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) th en return 0 end if;\nif NP <=1 then return op(ARGS) end if;\nreturn cm ul[eval(lname)](op(ARGS)); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 271 18 "No. 31. Procedure " }{TEXT 318 10 "useproduct" }{TEXT 319 80 " tha t allows user to select which procedure is used to compute Clifford pr oduct." }{TEXT 478 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1257 "usepr oduct:=proc(name::\{symbol,name\})\nlocal wstr;\nglobal _default_Cliff ord_product; #,cmulgen;\noptions `Copyright (c) 1995-2003 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: November 5, 2002`;\n####################################### ######\n############################################################## #####\n###This procedure uses global variable _default_Clifford_produc t #\n################################################################ ### \nif not member(name,\{cmulRS,cmulNUM,cmulgen,cmul_user_defined\}) then \n WARNING(\"expecting one of the following Clifford products : cmulRS, cmulNUM, cmulgen, or cmul_user_defined\") \nend if;\nif memb er(name,\{cmul_user_defined\}) and not type(name,procedure) then\n W ARNING(\"no computations with cmul can be peformed yet since cmul_user _defined has not been defined as procedure. Select cmulRS, cmulNUM, or a new procedure as argument to useproduct.\");\n _default_Clifford_ product:=name;\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(wstr);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 32 . Procedure " }{TEXT 320 5 "cmulQ" }{TEXT -1 20 " and its infix form \+ " }{TEXT 321 3 "&cQ" }{TEXT -1 514 " is a special version of 'cmul' an d '&c'. It gives the Clifford multiplication in the Clifford algebra \+ of the quadratic form Q related to the symmetric part g of B as Q(x) = g(x, x) = B(x, x) where B = g + A (A is the alternating part of B). \+ Like 'cmul', it works now in all dimensions 1 through 9. Via the proc edure 'rmulm' described below in (32), this multiplication can also be applied to matrices with entries in a Clifford algebra.\n\nThis proce dure can now accept an optional index which could be K or -K. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 78 "Propo sed by Yvon Siret, Universite Joseph Fourier , Grenoble, France. Than ks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 158 "Typical use: cmulQ(e1 + e2 + 2*Id, e3we4 + e6); or (e1 + e2) &cQ \+ (2*e2we3 + e4); or &cQ(e1, e2, e3); \n cmulQ(e1 we2+e2,e3+e4,e5-Pi*Id); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1423 "cmulQ:=proc() local ii,N,L,m,Sxy,symbxy,lna me,coB,nameB;global B:\noptions `Copyright (c) 1995-2003 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n######################################## #####\n####################################\nif type(op(procname),proc edure) then\n lname:=`B`;\nelse\n lname:=op(procname);\nend if; \n####################################\nif member(0,[args]) then retur n 0 end if;\n####################################\nSxy:=map(op,map(cli terms,\{args\}));\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers')); \nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n return cmul[lname](args) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when bot h x and y have maxindex=0\nif type(evalm(lname),matrix) then \n N:=l inalg[coldim](evalm(lname)):\n if m>N then \n error \"input con tains index larger than size of bilinear form %1\",lname \n end if: \nend if:\n################################\nif type(lname,\{name,symb ol,array,matrix\}) then\n L:=seq(lname[ii,ii],ii=1..m);\n return c mul[linalg[diag](L)](args);\nelif \n type(lname,`&*`(numeric,\{name, symbol,array,matrix\})) then\n coB:=op(select(type,\{op(lname)\},num eric));\n nameB:=op(select(type,\{op(lname)\},\{name,symbol,array,ma trix\}));\n L:=seq(coB*nameB[ii,ii],ii=1..m);\n return cmul[linalg [diag](L)](args); \nelse\n error \"index of unexpected type has bee n found in cmulQ\"\nend if;\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 272 29 "No. 33. Ampersand version of " }{TEXT 322 5 "cmulQ" }{TEXT 323 222 ". This version can accept index B and -B. When B has been defined as matrix, use\n&cQ[''B''](e1,e2) and &cQ[''-B''](e1,e2) . Otherwise, use &cQ[B](e1,e2), &cQ[-B](e1,e2) or &cQ(e1,e2). \n(Has been moved to Clifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 34. Procedu re " }{TEXT 324 10 "scalarpart" }{TEXT -1 137 " computes the scalar pa rt of the given Clifford polynomial. For example, scalarpart(e1 + e2 we3) = 0 but scalarpart(2*Id + e2we3) = 2. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: scalarpart (2*Id + e1 + e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 375 "scalar part:=proc(a::\{cliscalar,clibasmon,climon,clipolynom\}) local a1,p; \+ \noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: November 5, \+ 2002`;\n#############################################\na1:=simplify(a) :\nif type(a1,cliscalar) then return a1 end if;\np:=clicollect(a1):\nr eturn coeff(p,Id);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. \+ 35. Procedure " }{TEXT 325 10 "vectorpart" }{TEXT -1 353 " computes th e k-vector part of the given Clifford polynomial u where k is a nonneg ative integer. For example, vectorpart(e1 + 3*e2we3, 2) = 3*e2we3. Wh en k = 0 then the procedure returns the scalar part of u times 'Id', e .g., vectorpart(2*Id + 3*e2we3, 0) = 2*Id. Note that vectorpart(2*Id \+ + e1we2, 0) equals 2*Id while scalarpart(2*Id + e1we2) = 2. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 47 "Typic al use: vectorpart(e1 + e2we3 + e3, 1); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 570 "vectorpart:=proc(a::\{cliscalar,clibasmon,climon,cli polynom\},a2::nonnegint) \nlocal a1,p,K;\noptions `Copyright (c) 1995- 2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: November 5, 2002`;\n##################### ########################\na1:=simplify(a):\nif maxgrade(a1) < a2 then \+ return 0 end if;\n K:=proc() if maxgrade(args[1])=a2 then true else \+ false end if end proc:\nif type(a1,`+`) then p:=select(K,a1) elif\n \+ maxgrade(a1)<>a2 then p:=NULL else \n p:=a1 \nend if;\nif p=NULL the n 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 1359 "cexp:=proc(p::\{numeric ,cliscalar,clibasmon,climon,clipolynom\},N::nonnegint) \nlocal pp,k,an s,ans1,ans2,lname,coB,nameB;\noptions `Copyright (c) 1995-2003 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\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,a rray\}) then\n coB:=1:\n nameB:=args[3];\n lname:=ar gs[3];\n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array \})) then\n coB:=op(select(type,\{op(args[3])\},numeric));\n \+ nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=arg s[3]:\n else \n error \"wrong type of third argument in cexp. See ?cexp for more help.\" \n end if;\nelse\n error \"two or thr ee arguments expected in cexp. See ?cexp for more help.\"\nend if;\n## ##############################\nk:='k':\nif type(p,\{numeric,cliscalar \}) then return (add(p^k/k!,k=0..N)) end if;\nif evalb(vectorpart(p,0) =p) then \n pp:=scalarpart(p);\n return ((add(pp^k/k!,k=0..N)*Id)) \nend if;\npp:=clisort(displayid(p)):\nif N=0 then return Id \n eli f N=1 then return Id+pp; \n else \n ans1:=cexp(pp,N-1,lname); \n ans2:=cexp(pp,N-2,lname);\n ans:=ans1+cmul[lname](((ans 1-ans2)*(N-1)!),pp)/N!;\n return ans;\nend if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 37. Procedure " }{TEXT 327 5 "cexpQ " }{TEXT -1 257 " computes Clifford exponential of a Clifford number i n Cl(Q) up to the order specified by the second argument which is a n onnegative integer n. It n = 0 then this procedure returns 'Id'. This procedure can also accept an optional argument such as B or -B." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 210 "Typi cal use: cexpQ(e1we2*t, 3); or cexpQ((e1 + 2*e1we2)*t, 4);\n \+ cexpQ(e1we2*t, 3,K); or cexpQ((e1 + 2*e1we2)*t, 4,K);\n \+ cexpQ(Id+2*e1we3,4); or cexpQ(e1 + 2*e1we2, 4,-K);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1373 "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-2003 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: November 5, 2002`;\n####################################### ######\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lname:=`B` : \nelif nargs=3 then\n if type(args[3],\{name,symbol,matrix,array \}) then\n coB:=1:\n nameB:=args[3];\n lname:=args[3 ];\n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array\})) \+ then\n coB:=op(select(type,\{op(args[3])\},numeric));\n na meB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]: \n else \n error \"wrong type of third argument in cexpQ. See ?cexpQ for more help.\" \n end if;\nelse\n error \"two or three \+ arguments expected in cexpQ. See ?cexpQ for more help.\"\nend if;\n### #############################\nk:='k':\nif type(p,\{numeric,cliscalar \}) then return (add(p^k/k!,k=0..N)) end if;\nif evalb(vectorpart(p,0) =p) then \n pp:=scalarpart(p);\n return add(pp^k/k!,k=0..N)*Id \ne nd if;\npp:=clisort(displayid(p)):\nif N=0 then return Id \n elif N= 1 then return Id+pp; \n else \n ans1:=cexpQ(pp,N-1,lname); \n ans2:=cexpQ(pp,N-2,lname);\n ans:=ans1+cmulQ[lname] (((ans1-ans2)*(N-1)!),pp)/N!;\n return ans;\nend if;\nend proc :\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 38. Procedure " }{TEXT 328 4 "wexp" }{TEXT -1 168 " computes exterior exponential of a Clifford n umber u up to the order specified by the second argument which is a n onnegative integer n. It returns 'Id' when n = 0. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "Typical use: wexp( e1we2 + e3we4, 5); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 610 "wexp:= pr oc(p::\{cliscalar,clibasmon,climon,clipolynom\},N::nonnegative) \nloca l pp,power,cu,i;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revis ed: November 5, 2002`;\n############################################# \n if nargs<>2 then error \"two parameters are needed in 'wexp'\" end if;\n pp:=expand(p);\n if N=0 then return 1 elif\n N=1 then ret urn 1+clisort(pp) end if;\n power:=pp;\n cu:=1+pp;\n for i from 2 t o N do\n power:=wedge(power,pp);\n cu:=cu + power/i!;\n end d o;\n return subs(Id=1,clicollect(clisort(cu)));\n end proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 39. Procedure " }{TEXT 329 9 "rever sion" }{TEXT -1 411 " calculates reversion in the Clifford algebra. It is linear in its argument and it is always a Clifford algebra anti-au tomorphism. When the antisymmetric part of B is not zero, 'reversion' does not preserve the multilinear structure of the algebra because it mixes grades, i.e., it does not preserve the gradation of the exterio r algebra. This procedure can now take a third optional argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 53 "Typical use: reversion(2*e1we2 + 4*Id - e3we4we5); \n" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 2639 "reversion:=proc(a1::\{cliscalar, clibasmon,climon,clipolynom,matrix\}) \n local ind,expr,wtp, ptw,lname,flagindexed;\n global _scalartypes,B;\noptions `Co pyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: November 5, 2002`;\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,clisca lar) then return a1 end if;\n############################\nif nargs=1 \+ then\n lname:=`B`;\n flagindexed:=false:\nelif nargs=2 and type( args[2],\{symbol,name,array,matrix,`&*`(algebraic,name)\}) then\n l name:=args[2];\n flagindexed:=true:\nelse error \"only one or two a rguments are expected\"\nend if;\n############################\n### Au xiliary function that converts wedges to Clifford products: wedge ->> \+ Clifford product\n############################\nwtp:=proc(a1,lname) lo cal ind,i,arg,rdmon,eq1,ans; global _scalartypes; \nif type(a1,\{`+` ,`*`\}) then return (map(wtp,a1,lname)) \n elif type(a1,_scalartypes ) then return a1\n elif type(a1,symbol) and SearchText(w,a1)=0 then \+ return a1\n elif type(a1,symbol) and not member(length(a1),\{5,8,11, 14,17,20,23,26\}) \n then return a1 \nend if;\nrdmon:=reorder(a 1):\nind:=Clifford:-extract(a1,'integers'):\ni:='i':\narg:=[seq(cat(e, op(ind[i])),i=1..nops(ind))];\neq1:=cat(op(arg))=simplify(eval(cmul[ln ame](op(arg))));\nif a1=rdmon then ans:=simplify(solve(eq1,a1)) \n \+ else ans:=-simplify(solve(-eq1,-rdmon)) \nend if;\nif nops( ind) < 4 then return ans else return wtp(ans,lname) end if;\nend proc: \n############################\n### Auxiliary function that converts C lifford products to wedge: Clifford products ->> wedge\n############## ##############\nptw:=proc(a1,lname) local i,arg,revarg; global _scalar types; \nif type(a1,\{`+`,`*`\}) then return (map(ptw,a1,lname)) \n \+ elif type(a1,_scalartypes) then return a1 \n elif type(a1,symbol) an d SearchText(e,a1)=0 then return a1 \n elif type(a1,symbol) and leng th(a1)=2 then return a1 \n elif type(a1,symbol) and not member(lengt h(a1),\{2,4,6,8,10,12,14,16,18\})\n then return a1 \n end if;\n i:='i':\narg:=[seq(cat(e,substring(a1,2*i..2*i)),i=1..(length(a1)/2))] ;\nrevarg:=[seq(arg[nops(arg)-i],i=0..(nops(arg)-1))];\nreturn expand( eval(cmul[lname](op(revarg))))\nend proc:\n########################### ###\n### Now the actual function:\n##############################\nif \+ type(a1,matrix) then return map(reversion,a1,lname) end if;\nexpr:=ptw (expand(wtp(a1,lname)),lname);\nexpr:=expand(displayid(expr)):\nreturn clisort(expr)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 40. \+ Procedure " }{TEXT 330 11 "conjugation" }{TEXT -1 317 " calculates con jugation in the Clifford algebra. It is linear in its argument. Note \+ that 'conjugation' is defined as a composition of 'reversion' and 'gra deinv'. Hence, it does not preserve the multivector gradation when th e antisymmetric part of B is non-zero. It can now accept optional arg ument 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 823 "co njugation:=proc(a1::algebraic) local lname;global B;\noptions `Copyrig ht (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: November 5, 2002`;\n########## ###################################\nif nargs=1 then\n lname:=`B`; \nelif nargs=2 and type(args[2],\n \{symbol,name,array,matrix,`&*` (numeric,\{symbol,name,array,matrix\})\}) then\n lname:=args[2];\ne lse error \"only one or two arguments are expected\"\nend if;\n####### ####################\nif type(a1,matrix) then return map(procname,a1,l name) elif\n type(a1,cliscalar) then return a1 elif\n type(a1,\{cl ibasmon,climon,clipolynom\}) then\n return eval(gradeinv(revers ion(a1,lname)))\nelse \n error \"wrong input type: input must be of \+ type cliscalar, clibasmon, climon, clipolynom, or 'matrix'\" \nend if; \nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 41. Procedure " }{TEXT 331 8 "c_conjug" }{TEXT -1 72 " calculates complex conjugate in a complexified Clifford algebra; thu s, " }}{PARA 258 "" 0 "" {TEXT -1 80 " \+ c_conjug(u) = c_conjug(a + I*b) = a - I*b " }}{PARA 258 "" 0 "" {TEXT -1 140 "where a and b are in the real Clifford algebra and `I` i s the imaginary unit, i.e., I = sqrt(-1). This procedure is linear in \+ its argument. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 51 "Typical use: c_conjug((1 + 2*I)*e1 - 3*I*e1we2); \n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 697 "c_conjug:=proc(a1::algebraic) loca l ba,co,terms,t,i;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: November 5, 2002`;\n############################################ #\nif type(a1,matrix) then return map(procname,a1) elif\n type(a1,cl iscalar) 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 retur n clisort(add(conjugate(co[i])*terms[i],i=1..nops(co)))\n else \nerr or \"wrong input type: input must be of type cliscalar, clibasmon, cli mon, 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 au tomorphism action with respect to an ordered basis specified by the us er. The element p is entered as the first argument and the basis in t he form of a list is specified as the second argument, e.g., buildm(u, basis). It is also possible to specify options 'left', 'right', 'Lie ', 'auto', 'false, and 'true'. For example, one can find the left-regu lar representation of the algebra on itself or, when Cl(B) is simple a nd isomorphic to a ring of real matrices, one can find matrices repres enting Clifford polynomials in a real basis of a minimal ideal. Howev er, there are new procedures below specifically designed for finding s pinor representations of Clifford algebras in terms of real, complex, \+ and quaternionic matrices. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 270 "Typical use: \n\nbuildm(e1, [Id, e1, e 2, e1we2]); buildm(e1, [Id, e1, e2, e1we2], 'right'); buildm(e1, [Id, \+ e1, e2, e1we2], 'Lie');\nbuildm(e2, [Id, e1, e2, e1we2],'false'); buil dm(e1we2+e2, [Id, e1, e2, e1we2], 'true'); buildm(e1, [Id, e1, e2, e1w e2], 'Lie','false'); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2967 "bui ldm:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ a2::list(\{cliscalar,clibasmon,climon,clipolynom\}))\nlocal A,L,N,a11 ,xm,i,j,Lbasis,neq,vars,sys,sol,nontrivial,a33,flag;\noptions `Copyrig ht (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: November 5, 2002`;\n########## ###################################\nflag:=true:\nif nargs=2 then a33: ='left' end if;\nif nargs=3 then \n if member(args[3],\{'true','fals e'\}) then flag:=args[3];\n \+ a33:='left';\n elif member(args[3],\{'left','right','Lie','auto'\} ) \n then a33:=args[3]\n else \+ error \"third optional argument must be 'left', 'right', 'Lie', 'auto' , 'true', 'false'\"\n end if; \nend if;\nif nargs=4 then\n if memb er(args[3],\{'left','right','Lie','auto'\}) and member(args[4],\{'fals e','true'\}) then\n a33:=args[3]; \n flag:=args[4];\n else \n error \"third optional argument must be 'left', 'right ', 'Lie', 'auto', and the fourth optional argument must be 'false' or \+ 'true'\"\n end if;\nend if;\nif nargs>4 then error \"too many argume nts. See ?buildm for more help.\" end if;\n########################### ######################\nif flag then \nA:=linalg[genmatrix](args[2],cb asis(maxindex(args[2])));\nif linalg[rank](A) < nops(args[2]) then \n \+ error \"elements of the list %1 are linearly dependent. Apply 'findb asis' to this list first.\",a2 \nend if;\nend if;\n###local procedure \nnontrivial:=proc(S::\{set(\{relation,algebraic\}),list(\{relation,al gebraic\})\}) \nlocal istrivial;\nprintlevel:=2:\nistrivial:=proc(x) i f type(x,relation) then evalb(x) else evalb(x=0) end if end;\nremove(i strivial,S)\nend proc:\n### \nL:=a2:N:=nops(L):xm:=array(1..N,1..N):\n if a33='left' then \n for i from 1 to N do \n eq||i:=clicoll ect(expand(cmul(a1,L[i])-add(xm[j,i]*L[j],j=1..N))) \n end do;\neli f a33='right' then \n for i from 1 to N do \n \+ eq||i:=clicollect(expand(cmul(L[i],a1)-add(xm[j,i]*L[j],j=1..N)))\n \+ end do;\nelif a33='Lie' then\n for i from 1 to N do\n e q||i:=clicollect(expand(cmul(L[i],a1)-cmul(a1,L[i])-add(xm[j,i]*L[j],j =1..N)))\n end do;\nelif a33='auto' then\n a11:=cinv(a1):\n \+ for i from 1 to N do \n eq||i:=clicollect(ex pand(cmul(cmul(a1,L[i]),a11)-add(xm[j,i]*L[j],j=1..N)))\n end do; \nelse error \"third optional argument must be 'left', 'right', 'Lie', or 'auto'\"\nend if;\n############################################### ###########\nLbasis:=[op(`union` (seq(cliterms(L[i]),i=1..N)))];\nfor \+ i from 1 to N do \n for j from 1 to nops(Lbasis) do \n neq[i ,j]:=coeff(eq||i,Lbasis[j])=0 \nend do;\nend do;\nvars:=convert(evalm( xm),set):sys:=map(op,\{entries(neq)\});\nsys:=nontrivial(sys): #elimin ate trivial equations\nsol:=solve(sys,vars);\nif sol=NULL then \n er ror \"no matrix represents %1 in the basis %2 under the %3 action\",a1 ,a2,a33; \nend if;\nassign(sol);\nreturn evalm(xm);\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 43. Procedure " }{TEXT 333 9 "findb asis" }{TEXT -1 680 " finds a basis in a linear vector space spanned b y a set of Clifford polynomials entered as a list. The procedure is u sed, for example, when finding a basis for a spinor space S considere d as a minimal left or right ideal in Cl(B) generated by a primitive i dempotent f. To speed up computations, it is advisable to a standard C lifford basis for Cl(B) in the form of a list of basis monomials as th e second argument. If only one list is specified, 'findbasis' determi nes a suitable Clifford basis itself but it takes twice as much time t hen since it creates a Clifford basis by using 'cbasis(maxindex)' wher e 'maxindex' is the maximum index found among the elements of the list ." }}{PARA 258 "" 0 "" {TEXT -1 69 "\nTypical use: findbasis([2*e1+e2, e2+e1we2,e1we2],[Id,e1,e2,e1we2]);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1428 "findbasis:=proc(a1,a2) local L,clibasis,M,i,m,r,v,S; \nglobal \+ _prolevel;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: No vember 5, 2002`;\n#############################################\nif ev alb(_prolevel=false) then\n if nargs=1 and not (type(a1,list(\{cliba smon,climon,clipolynom\})) or \n type(a1,set(\{c libasmon,climon,clipolynom\}))) then\nerror \"argument of type list/se t(\{clibasmon,climon, or clipolynom\}) was expected\"\n elif nargs=2 and \n not ((type(a1,list(\{clibasmon,climon,clipolynom\})) or \+ \n type(a1, set(\{clibasmon,climon,clipolynom\}))) and \n \+ (type(a2,list(clibasmon)) or type(a2,set(clibasmon)))) or nar gs>2 then\nerror \"arguments of type list/set(\{clibasmon,climon,clipo lynom\}) and list/set(clibasmon) were expected\" \nend if;\nend if;\ni f nops(a1)=1 then return a1 end if;\nL:=sort(map(displayid,convert(a1, list)),bygrade):\nif nargs=2 then clibasis:=sort(convert(a2,list),bygr ade) else \n clibasis:=sort(convert(`union`(op(map(cliterms,L))),lis t),bygrade);\nend if;\nM:=linalg[genmatrix](L,clibasis);\nr:=linalg[ra nk](M):m:=linalg[rowdim](M):\nfor i from 1 to m do v[i]:=linalg[row](M ,i) end do;\nS:=[v[1]]:\nfor i from 2 to m while nops(S) < r do \n \+ if linalg[rank](linalg[stackmatrix](op(S),v[i]))=nops(S)+1 \n th en S:=[op(S),v[i]] \n end if\nend do;\nreturn [seq(L[i],i=map(op,S) )]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 44. Procedure " }{TEXT 334 12 "minimalideal" }{TEXT -1 143 " calculates a real basis f or a left S=Cl(B)f or right S=fCl(B) minimal ideal in the algebra Cl(B ) where f is a primitive idempotent in Cl(B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 151 "The first argument of \+ the procedure is an ordered list of basis monomials sorted bygrade, e. g., a Clifford basis generated by the procedure 'cbasis'. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 198 "Note: to s ort a list L by grade one may use sort(L, bygrade) where 'bygrade' i s a new procedure in this package described below. The output from th e procedure 'cbasis' is already sorted that way." }}{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' uses the generators of S stor ed under clidata()[5] to generate the real basis and it returns the st ored list clidata()[5] as the second list in its ouput. If f does n ot equal clidata()[4] then complete computations are performed but th ey 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 ord ered 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 second list contains basis m onomials from the standard basis in Cl(B) which generate the \+ " }}{PARA 258 "" 0 "" {TEXT -1 108 " first list by multiplying f o n the left or on the right depending whether S=Cl(B)f or S=fCl(B). \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 257 260 "There is a one-to-one correspodence between the two ordered lists .\n\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 2246 "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,_shortcut_in_minimalid eal,_prolevel;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz a nd Bertfried Fauser. All rights reserved.`;\ndescription `Last revised : November 5, 2002`;\n#############################################\ni f not type(B,diagmatrix) then \n error \"bilinear form B has not bee n assigned a matrix or is not diagonal\" \nend if; \nif not _prolevel \+ then\n if not type(a1,list(\{clibasmon,climon,clipolynom\})) then\n \+ error \"first argument must of type list(\{clibasmon,climon,c lipolynom\})\" \n elif not type(a2,'primitiveidemp') then \n \+ error \"second argument must be a primitive idempotent\" \n \+ elif not member(a3,\{'left','right',\"left\",\"right\"\}) th en\n error \"third argument must be 'left', or 'rig ht'\" \n end if;\n end if;\nf:=displayid(eval(a2)):\nif member(a3,\{'l eft',\"left\"\}) then flag_left:=true else flag_left:=false end if;\ng :='g':\nL:=sort(a1,bygrade):\nif _shortcut_in_minimalideal then\n m: =maxindex(L):\n flag1:=evalb(L=cbasis(m)): \n if flag1 then\n \+ data:=clidata():\n if eval(eval(data[4]))=eval(f) or eval(eval( data[4]))=gradeinv(f) then\n SBgens:=data[5]:\n if fla g_left then SB:=[seq(cmulQ(g,f),g=SBgens)] else \n \+ SB:=[seq(cmulQ(f,g),g=SBgens)] \n end if;\n retu rn [SB,SBgens,a3];\n end if;\n end if;\nend if; \n#If can't \+ use the shortcut, perform necessary computations.\npq:=Bsignature():\n p:=pq[1]:q:=pq[2]:\nl:=floor((p+q)/2);ni:=2^(l-1);\nif member((p-q) mo d 8,\{0,1,2\}) then \n realdim:=2*ni; \n dimoverK:=2*ni; \ne lif member((p-q) mod 8,\{3,7\}) then \n realdim:=4*ni; \n di moverK:=2*ni; \nelse\n realdim:=4*ni; \n dimoverK:=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]:c b:=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];\n end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 48. Procedure " } {TEXT 335 6 "Kfield" }{TEXT -1 340 " computes a basis for 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, respectively (here [p,q] is the signature of B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 205 "Assuming that the bilinear form B has been d efined, the first argument of the procedure is expected 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 e lements in the real ideal space nilpotent elements and leaves only tho se whose square modulo f is either +1 or -1. It returns those element s 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 stored under clidat a()[5], then the procedure" }}{PARA 258 "" 0 "" {TEXT -1 99 "uses gene rators of K stored under clidata()[6] and returns them as the second \+ list in its ouput. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 178 "Thus, the second list in the output contains gene rators (Clifford basis monomials) of the elements in the first list. \+ Elements of the two lists are in one-to-one relationship. " }}{PARA 258 "" 0 "" {TEXT -1 204 "\nTypical use: dim:=2:B:=linalg[diag](1,-1): 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 4296 "Kfiel d:=proc(a1::list(\{list,string,symbol\}),a2::clipolynom) \nlocal SB,ge ns,f,ff,k,n,fg,f_from_data,field,flag3,side,expr,i,ijk,g,dimen,Kbasis, Kgens,Kdim,data,T4: \nglobal B,_shortcut_in_Kfield,_prolevel;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. Al l rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n# ############################################\n#### Local procedure nee ded only in 'Kfield' ###\nT4:=proc() \nlocal gens,Kbasis,f,mi,clibas,c libas2,x,y,z; global B;\nKbasis:=args[1];f:=Kbasis[1];mi:=max(op(map(m axindex,Kbasis)));\nclibas:=subsop(1=NULL,cbasis(mi));\nif type(B,matr ix) then gens:=subsop(1=NULL,clidata()[6]);\n clib as:=remove(member,clibas,gens):\n clibas:=[op(gens ),op(clibas)];\nend if;\nclibas2:=[]:\nfor x in clibas do \n if eva lb(cmul(x,x) = -Id) then clibas2:=[op(clibas2),x] end if; \nend do:\nf or x in clibas2 do \nfor y in remove(member,clibas2,[x]) do\nfor z in \+ remove(member,clibas2,[x,y]) do\n if member(cmul(x,f),\{Kbasis[2] ,-Kbasis[2]\}) then \n if member(cmul(y,f),\{Kbasis[3],-Kbasis [3]\}) then\n if member(cmul(z,f),\{Kbasis[4],-Kbasis[4]\}) then \n if type([x,y,z],'purequatbasis') then return [x ,y,z]\n end if;\n end if;\n end if;\n end if;\nend do;\nend do;\ne nd do;\nend proc:\n##############################################\nif \+ not _prolevel then\n if not type(a2,'primitiveidemp') then \n e rror \"second argument must be a primitive idempotent\"\n end if;\ne nd if;\nSB:=a1[1]:gens:=a1[2]:side:=a1[3]:f:=eval(a2):i:='i':g:='g':\n if not member(f,SB) then \n error \"idempotent entered %1 is not a m ember 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 mus t be assigned to B\" \nend if;\nif side='left' then flag3:=true else f lag3:=false end if;\ndata:=clidata():\nfield:=data[1]:\nif field = 're al' then return [[f],[Id]] \nelif field = 'complex' then \n if _shortcut_in_Kfield then\n f_from_data:=eval(eval(data[4])) :\n fg:=gradeinv(f): \n if member(f_from_data,\{f ,-f,fg,-fg\}) and gens=data[5] then \+ Kgens:=data[6];\nif flag3 then Kbasis:=[f,seq (cmul(Kgens[i],f),i=2..nops(Kgens))]\n else Kbasis:=[f,seq(cmu l(f,Kgens[i]),i=2..nops(Kgens))] \nend if;\nreturn ([Kbasis,Kgens]) \n end if;\nend if;\n#Do this when shortcut can't be used when field = 'c omplex'\nKdim:=2: \nKbasis:=[f]:Kgens:=[Id]:ff:=[op(data[4])]:n:=nops( ff);\nfor i from 1 to nops(SB) while nops(Kbasis) < Kdim do\n if c mul(gens[i],gens[i])=-Id then\n expr:=gens[i]:\n for k f rom 1 to n while expr<>0 do\n expr:=cmul(ff[n-k+1],expr,ff[ k]);\n end do; \n if expr<>0 then Kbasis:=[op(Kbasis),SB[ i]];\n Kgens:=[op(Kgens),gens[i]] \n end if;\n \+ end if;\nend do;\nreturn [Kbasis,Kgens]\nelif field = 'quaternionic ' then \n dimen:=linalg[coldim](B):\n if dimen=2 then Kbasis:= [op(SB)];\n Kgens:=[op(gens)];\n \+ return [Kbasis,Kgens]\n elif member(dimen,\{3,4,5,6,7,8,9\}) th en\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;\n end if;\n#Do this when shortcut can't be used and field = 'quaternioni c'\nKdim:=4:\nKbasis:=[f]:Kgens:=[Id]:ff:=[op(data[4])]:n:=nops(ff);\n for i from 1 to nops(SB) while nops(Kbasis) < Kdim do\n if cmul(ge ns[i],gens[i])=-Id then\n expr:=gens[i]:\n for k from 1 \+ to n while expr<>0 do\n expr:=cmul(ff[n-k+1],expr,ff[k]);\n end do; \n if expr<>0 then Kbasis:=[op(Kbasis),SB[i]] e nd if;\nend if;\nend do;\n ijk:=T4(Kbasis);\n Kgens:=[Id,op(ij k)]:\nif flag3 then Kbasis:=[f,seq(cmul(g,f),g=ijk)] else \n \+ Kbasis:=[f,seq(cmul(f,g),g=ijk)]\nend if;\nreturn [Kbasis,Kgens]\n else error \"wrong name of the field. See ?Kfield for more help.\" \n end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 46. Procedu re " }{TEXT 336 12 "spinorKbasis" }{TEXT -1 263 " finds a spinor basis for S=Cl(B)f or S=fCl(B) over a field K where K is isomorphic to the reals, or to the complexes, or to the quaternions according to whethe r (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respectively (here [p,q] is the signature of B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 276 "The first argument is an ordered list \+ SBgens containing generators of a real basis in a minimal ideal Cl(B)f or fCl(B) (it doesn't matter whether the ideal was left or right). T hese generators are found by the procedure 'minimalideal' and are retu rned by it as a second list." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 104 "The second argument is the primitive i dempotent f used to generate the minimal ideal Cl(B)f or fCl(B)." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 150 "The \+ third argument is a list FBgens of generators that generate the field \+ K; these generators are returned as a second list by the procedure 'Kf ield'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 143 "The fourth argument is either 'left' or 'right' depending whet her we deal with the left minimal ideal Cl(B)f or the right minimal id eal Cl(B)f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 434 "If the first three arguments in the input match respecti vely clidata()[5], clidata()[4], and clidata()[6] in that order, i.e ., SBgens=clidata()[5], f=clidata()[4], and FBgens=clidata()[6], the n the procedure finds previously computed generators of S over K which are stored as clidata()[7]. These generators are then used to comput e the K-basis for S=Cl(B)f or S=fCl(B) depending whether the fourth ar gument is 'left' or 'right'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 47 "The procedure returns a list of three e lements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 163 "(1) the first list is an ordered list of Clifford polynomials \+ which give a basis in Cl(B)f or fCl(B) (depending on what was the fou rth 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. Ther e 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 procedure. That elem ent is to remind the user that the basis returned as the first list is for the left or right ideal respectively. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 334 "Typical use: dim:=2:B: =linalg[diag](1,-1):clibasis:=cbasis(dim):data:=clidata(B):f:=data[4]: \n sbasis:=minimalideal(clibasis,f,'left');\n \+ fbasis:=Kfield(sbasis,f);\n \+ SBgens:=sbasis[2];FBgens:=fbasis[2];\n s pinorKbasis(SBgens,f,FBgens,'left')\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2864 "spinorKbasis:=\nproc(a1::list,a2::\{clibasmon,climon,clipolyno m\},a3::list,a4::\{string,symbol\}) \nlocal flag,flag_left,Kdim,f,SBge ns,SB,FBgens,g,SBKbasis,SBKgens,data,i,poss,m,p; \nglobal B,_shortcut_ in_spinorKbasis,_prolevel;\noptions `Copyright (c) 1995-2003 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: November 5, 2002`;\n#################################### #########\nif not type(B,matrix) then \n error \"matrix must be assi gned to B\" \nend if;\nif not _prolevel then\n if not type(a2,'idemp otent') then \n error \"second argument must be an idempotent\" e lif\n not member(a4,\{'left','right',\"left\",\"right\"\}) then \n \+ error \"the fourth argument must be 'left', or 'right'\"\n end i f;\nend if;\nSBgens:=a1:f:=eval(a2):FBgens:=a3:\nif SBgens=FBgens then return [[f],[Id],a4] end if;\nif a4='left' or a4=\"left\" then flag_l eft:=true else flag_left:=false end if;\ndata:=clidata():\nif _shortcu t_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(cmulQ(f,g),g=SBKge ns)]\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);\nSBKgens:=[Id]:\ng:= 'g':\nif flag_left then SB:=remove(member,SB,[seq(cmul(f,g),g=FBgens)] )\n else SB:=remove(member,SB,[seq(cmul(g,f),g=FBgens)])\n end if;\nposs:=remove(member,poss,FBgens);\nfor g in poss while nops(S B)>0 do\n if flag_left then \n for i from 1 to Kdim do p[i]:= cmul(g,f,FBgens[i]) end do;\n else \n for i from 1 to Kdim do p[i]:=cmul(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]) then\n S B:=remove(member,SB,[p[1],-p[1],p[2],-p[2]]):\n SBKgens:=[op( SBKgens),g]\n end if:\n else\n if (flag[1,1] or flag[2,1 ]) and \n (flag[1,2] or flag[2,2]) and\n (flag[1,3] or flag[2,3]) and\n (flag[1,4] or flag[2,4])\n then\n \+ SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2],p[3],-p[3],p[4],-p[4]]) :\n SBKgens:=[op(SBKgens),g]\n end if:\n end if;\n \+ if flag[1,1] then SBKbasis:=[op(SBKbasis),p[1]] else\n \+ SBKbasis:=[op(SBKbasis),-p[1]] \n end if;\n end do;\ng:='g ':\nif flag_left then SBKbasis:=[seq(cmul(g,f),g=SBKgens)] else\n \+ SBKbasis:=[seq(cmul(f,g),g=SBKgens)]\nend if;\nreturn [SB Kbasis,SBKgens,a4]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. \+ 47. Procedure " }{TEXT 337 10 "squaremodf" }{TEXT -1 390 " computes th e square of a basis element u in a left or right minimal ideal Cl(B)f \+ or fCl(B) entered as the first argument modulo a primitive idempotent f entered as the second argument. The procedure doesn't check wheth er f is primitive or not. Thus, the procedure returns 1 or -1 dependi ng whether cmul(u,u) = f or cmul(u,u) = -f. The procedure 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 783 "squaremodf:=proc(a1::\{clibasmon,c limon,clipolynom\},a2::idempotent) \nlocal p;global B;\noptions `Copyr ight (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: November 5, 2002`;\n######## #####################################\nif nargs<>2 then \n error \"t wo arguments needed of type clibasmon, or climon, or clipolynom, and ' idempotent'\" \nend if;\nif a1=a2 then return 1 elif\n not type(B,ma trix) then error \"matrix must be assigned to B\" \nend if;\np:=cmul(a 1,a1):\nif expand(p-a2)=0 then return 1 elif\n expand(p+a2)=0 then r eturn -1 elif\n (p=0 or type(a1,nilpotent)) then return 0 else \+ \n error \"either element %1 is not a basis element or it does not belong to the spinor space Cl(Q)f (or fCl(Q))\",a1 \nend if;\nend pr oc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 48. Procedure " }{TEXT 338 8 "RHnumber" }{TEXT -1 76 " gives the Radon-Hurwitz number for any integer.\n\nTypical use: RHnumber(2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 504 "RHnumber:=proc(a1::integer)\noptions `Copyright (c) \+ 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: November 5, 2002`;\n################# ############################\nif member(a1,\{0,1,2\}) then return a1 e lif\n a1=3 then return 2 elif\n member(a1,\{4,5,6,7\}) then return 3 elif\n a1>=8 then return RHnumber(a1-8)+4 elif\n a1<0 then retu rn 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 orthogonal 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 si gnature of B given as a list [p,q], or simply as clidata() (currently \+ defined B will then be used)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 47 "It returns a list with the following e lements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 187 "(a) the first entry is the string 'real', 'complex', or 'quat ernionic' 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 spi nor 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) th e fourth entry is a primitive idempotent f which may be used to gene rate a left or right minimal ideal in the algebra." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 574 "NOTE: the idempoten ts 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 basis monomials \+ ordered by grade which generate Cl(Q)f and fCl(Q).\n\n(f) the sixth en try is a list of basis monomials ordered by grade which give a basis f or K (this is in terms of these monomials that matrices representing C lifford polynomials will be written by the procedure 'spinorKrepr').\n " }}{PARA 258 "" 0 "" {TEXT -1 92 "(g) the seventh entry is a list of \+ basis monomials 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 currentl y defined bilinear form B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 81 "Typical use: clidata(); clidata([2,3]); clida ta(B);clidata(linalg[diag](1,1,1));\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 473 "clidata:=proc() local a1,clidata2;global B;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: November 5, 2002`;\n############ #################################\nif nargs=0 then a1:=`B` else a1:=ar gs end if:\nif not type(a1,\{list(nonnegint),matrix\}) then\n WARNIN G(\"to find out about Clifford algebra Cl_\{p,q\} try clidata([p,q]) o r enter ?clidata for more help\");\n return ('procname(args)')\nend \+ if;\n" }}{PARA 258 "" 0 "" {TEXT -1 76 "This is a data file that is re ad in when needed by the procedure 'clidata'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "clidata2" }{TEXT -1 0 "" }{MPLTEXT 1 0 16600 ":=proc(a 1::\{list(nonnegint),matrix\})\nlocal SBgens,FBgens,SBKgens,p,q,l,ni,K ,dimoverK,dimoverR,numfact,struct,primidemp;\nglobal B;\noptions `Copy right (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`,remember;\ndescription `Last revised: November 5, 2002`; \n#############################################\n#K = field of spinor \+ repesentation, it is R, C, or H depending on [p,q]\n#dimoverK = dimens ion of spinor representation over the field K\n#dimoverR = dimension o f spinor representation over the reals R\n#numfact = number of idempot ent factors in any primitive idempotent\n#SBgens = basis monomials gen erating Cl(Q)f and fCl(Q) over R\n#FBgens = basis monomials 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 o f -1 in the diagonal form Q of B\n#struct = structure of Cl(Q) is 'sim ple' 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 assig ned(B)<<<\nif not type(B,matrix) then \n error \"matrix must be assi gned 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 t ype(args[1],matrix) then \n p:=Bsignature(args)[1]; q:=Bsignatu re(args)[2] \n else \n error \"wrong argument types in 'clida ta'\" \n end if;\nif type(args[1],list(nonnegint)) and (p>9 or q>9) \+ then\n error \"p and q must satisfy 0 <= p,q <= 9\" \nend if;\nl:=fl oor((p+q)/2);ni:=2^(l-1);\nif member((p-q) mod 8,\{0,1,2\}) then \n \+ K:='real'; dimoverR:=2*ni; dimoverK:=2*ni; \nelif member((p-q) mod \+ 8,\{3,7\}) then \n K:='complex'; dimoverR:=2*2*ni; dimoverK:=2*ni ; else\n K:='quaternionic'; dimoverR:=4*ni; dimoverK:=ni \nend if ;\nnumfact:=q-RHnumber(q-p);\nif modp((p-q) = 1,4) then struct:='semis imple' \n else struct:='simple' \nend if;\nprimidemp:=table():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]]:=SBgens[[2,0]];\n \nprimidemp[[2,2]]:=\n''cmulQ''((1/2)*(Id+e1we3),(1/2)*(Id+e2we4));\nS Bgens[[2,2]]:=[Id,e1,e2,e1we2];\nFBgens[[2,2]]:=[Id];\nSBKgens[[2,2]]: =SBgens[[2,2]];\n\nprimidemp[[3,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*( Id+e3we4));\nSBgens[[3,1]]:=[Id,e2,e3,e2we3];\nFBgens[[3,1]]:=[Id];\nS BKgens[[3,1]]:=SBgens[[3,1]];\n\nprimidemp[[0,6]]:=\n''cmulQ''((1/2)*( Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6));\nSBgens[[0,6]]: =[Id,e1,e2,e3,e4,e5,e6,e1we5];\nFBgens[[0,6]]:=[Id];\nSBKgens[[0,6]]:= SBgens[[0,6]];\n\nprimidemp[[3,3]]:=\n''cmulQ''((1/2)*(Id+e1we4),(1/2) *(Id+e2we5),(1/2)*(Id+e3we6));\nSBgens[[3,3]]:=[Id,e1,e2,e3,e1we2,e1we 3,e2we3,e1we2we3];\nFBgens[[3,3]]:=[Id];\nSBKgens[[3,3]]:=SBgens[[3,3] ];\n\nprimidemp[[4,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e3we5),(1/ 2)*(Id+e4we6));\nSBgens[[4,2]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we 4];\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,e1we2we3we4] ;\nFBgens[[4,4]]:=[Id];\nSBKgens[[4,4]]:=SBgens[[4,4]];\n\nprimidemp[[ 5,3]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e3we6),(1/2)*(Id+e4we7),(1/ 2)*(Id+e5we8));\nSBgens[[5,3]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we 4,e3we5,e4we5,e2we3we4,\ne2we3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBg ens[[5,3]]:=[Id];\nSBKgens[[5,3]]:=SBgens[[5,3]];\n\nprimidemp[[8,0]]: =\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e4we5we6we 7),\n (1/2)*(Id+e2we4we6we8));\nSBgens[[8,0]]:=[Id,e2,e3,e4,e 5,e6,e7,e8,e2we3,e2we4,e2we5,e2we6,e2we7,\ne2we8,e3we8,e2we3we8];\nFBg ens[[8,0]]:=[Id];\nSBKgens[[8,0]]:=SBgens[[8,0]];\n\nprimidemp[[1,7]]: =\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e4we5we6),(1/2)*(Id+e2we5we 7),\n (1/2)*(Id+e1we8));\nSBgens[[1,7]]:=[Id,e1,e2,e3,e4,e5,e 6,e7,e1we2,e1we3,e1we4,e1we5,e1we6,\ne1we7,e2we6,e1we2we6];\nFBgens[[1 ,7]]:=[Id];\nSBKgens[[1,7]]:=SBgens[[1,7]];\n\nprimidemp[[0,8]]:=\n''c mulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6),\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)\npri midemp[[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+e1);\nSBgens [[3,0]]:=[Id,e2,e3,e2we3];\nFBgens[[3,0]]:=[Id,e2we3];\nSBKgens[[3,0]] :=[Id,e2];\n\nprimidemp[[0,5]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)* (Id+e3we4we5));\nSBgens[[0,5]]:=[Id,e1,e2,e3,e4,e5,e1we4,e1we5];\nFBge ns[[0,5]]:=[Id,e3];\nSBKgens[[0,5]]:=[Id,e1,e4,e1we4];\n\nprimidemp[[2 ,3]]:=\n''cmulQ''((1/2)*(Id+e1we4),(1/2)*(Id+e2we5));\nSBgens[[2,3]]:= [Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\nFBgens[[2,3]]:=[Id,e3];\nSB Kgens[[2,3]]:=[Id,e1,e2,e1we2];\n\nprimidemp[[4,1]]:=\n''cmulQ''((1/2) *(Id+e1),(1/2)*(Id+e4we5));\nSBgens[[4,1]]:=[Id,e2,e3,e4,e2we3,e2we4,e 3we4,e2we3we4];\nFBgens[[4,1]]:=[Id,e2we3];\nSBKgens[[4,1]]:=[Id,e2,e4 ,e2we4];\n\nprimidemp[[1,6]]:=\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(I d+e4we5we6),(1/2)*(Id+e1we7));\nSBgens[[1,6]]:=[Id,e1,e2,e3,e4,e5,e6,e 1we2,e1we3,e1we4,e1we5,e1we6,e2we5, \+ e2we6,e1we2we5,e1we2we6]; \nFBgens[[1,6]]:=[Id,e4];\nSBKg ens[[1,6]]:=[Id,e1,e2,e5,e1we2,e1we5,e2we5,e1we2we5];\n\nprimidemp[[3, 4]]:=\n''cmulQ''((1/2)*(Id+e1we5),(1/2)*(Id+e2we6),(1/2)*(Id+e3we7)); \nSBgens[[3,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4, \n e1we2we3,e1we2we4,e1we3we4,e2we3we4,e1we2we3we4]; \n FBgens[[3,4]]:=[Id,e4];\nSBKgens[[3,4]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we 3,e1we2we3];\n\nprimidemp[[5,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+ e4we6),(1/2)*(Id+e5we7));\nSBgens[[5,2]]:=[Id,e2,e3,e4,e5,e2we3,e2we4, e2we5,e3we4,e3we5,e4we5,\n e2we3we4,e2we3we5,e2we4we5,e 3we4we5,e2we3we4we5]; \nFBgens[[5,2]]:=[Id,e2we3];\nSBKgens[[5,2]]:=[I d,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));\nSBge ns[[7,0]]:=[Id,e2,e3,e4,e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2we7,\n \+ e4we6,e4we7,e2we4we6,e2we4we7]; \nFBgens[[7,0]]:=[Id,e2we3] ;\nSBKgens[[7,0]]:=[Id,e2,e4,e6,e2we4,e2we6,e4we6,e2we4we6];\n\nprimid emp[[0,9]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)* (Id+e1we4we6),\n (1/2)*(Id+e3we6we7));\nSBgens[[0,9]]:=\n[Id, e1,e2,e3,e4,e5,e6,e7,e8,e9,e1we8,e1we9,e2we8,e2we9,e3we8,e3we9,\n e4we 8,e4we9,e5we8,e5we9,e6we8,e6we9,e7we8,e7we9,e8we9,e1we8we9,\n e2we8we9 ,e3we8we9,e4we8we9,e5we8we9,e6we8we9,e7we8we9];\nFBgens[[0,9]]:=[Id,e8 we9];\nSBKgens[[0,9]]:=[Id,e1,e2,e3,e4,e5,e6,e7,e8,e1we8,e2we8,e3we8,e 4we8,\n e5we8,e6we8,e7we8];\n\nprimidemp[[2,7]]:=\n''c mulQ''((1/2)*(Id+e3we4we5),(1/2)*(Id+e5we6we7),(1/2)*(Id+e1we8),\n \+ (1/2)*(Id+e2we9));\nSBgens[[2,7]]:=\n[Id,e1,e2,e3,e4,e5,e6,e7,e1 we2,e1we3,e1we4,e1we5,e1we6,e1we7,e2we3,\n e2we4,e2we5,e2we6,e2we7,e3w e6,e3we7,e1we2we3,e1we2we4,e1we2we5,\n e1we2we6,e1we2we7,e1we3we6,e1we 3we7,e2we3we6,e2we3we7,e1we2we3we6,\n e1we2we3we7];\nFBgens[[2,7]]:=[I d,e5];\nSBKgens[[2,7]]:=\n[Id,e1,e2,e3,e6,e1we2,e1we3,e1we6,e2we3,e2we 6,e3we6,e1we2we3,e1we2we6,e1we3we6,\n e2we3we6,e1we2we3we6];\n\nprimid emp[[4,5]]:=\n''cmulQ''((1/2)*(Id+e1we6),(1/2)*(Id+e2we7),(1/2)*(Id+e3 we8),(1/2)*(Id+e4we9));\nSBgens[[4,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[[4,5]]:=[Id,e5];\nSBKgens[[4,5]]:=\n[Id,e1,e2 ,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4,e1we2we3,e1we2we4,\n e1we3w e4,e2we3we4,e1we2we3we4];\n\nprimidemp[[6,3]]:=\n''cmulQ''((1/2)*(Id+e 1),(1/2)*(Id+e4we7),(1/2)*(Id+e5we8),(1/2)*(Id+e6we9));\nSBgens[[6,3]] :=\n[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we4,e3we5,e3we6,e4we5 ,\n e4we6,e5we6,e2we3we4,e2we3we5,e2we3we6,e2we4we5,e2we4we6,e2we5we6, \n e3we4we5,e3we4we6,e3we5we6,e4we5we6,e2we3we4we5,e2we3we4we6,\n e2we 3we5we6,e2we4we5we6,e3we4we5we6,e2we3we4we5we6];\nFBgens[[6,3]]:=[Id,e 2we3];\nSBKgens[[6,3]]:=\n[Id,e2,e4,e5,e6,e2we4,e2we5,e2we6,e4we5,e4we 6,e5we6,e2we4we5,e2we4we6,\n e2we5we6,e4we5we6,e2we4we5we6];\n\nprimid emp[[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,e 4we7,e4we8,e5we8,e6we8,e7we8,e2we3we8,e2we4we6,e2we4we7,\n e2we4we8,e2 we5we8,e2we6we8,e2we7we8,e4we6we8,e4we7we8,e2we4we6we8,\n e2we4we7we8] ;\nFBgens[[8,1]]:=[Id,e2we3];\nSBKgens[[8,1]]:=\n[Id,e2,e4,e6,e8,e2we4 ,e2we6,e2we8,e4we6,e4we8,e6we8,e2we4we6,e2we4we8,\n e2we6we8,e4we6we8, e2we4we6we8];\n\n#Quaternionic, simple (12 cases)\nprimidemp[[0,2]]:=I d; #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+e1 we2we3);\nSBgens[[0,4]]:=[Id,e1,e2,e3,e4,e1we4,e2we4,e3we4];\nFBgens[[ 0,4]]:=[Id,e1,e1we3,e3];\nSBKgens[[0,4]]:=[Id,e4];\n\nprimidemp[[1,3]] :=(1/2)*(Id+e1we4);\nSBgens[[1,3]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1w e2we3];\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];\nSBKgen s[[4,0]]:=[Id,e2];\n\nprimidemp[[1,5]]:=\n''cmulQ''((1/2)*(Id+e2we3we4 ),(1/2)*(Id+e1we6));\nSBgens[[1,5]]:=[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1 we4,e1we5,e2we5,e3we5,\n e4we5,e1we2we5,e1we3we5,e1we4w e5];\nFBgens[[1,5]]:=[Id,e2,e2we4,e4];\nSBKgens[[1,5]]:=[Id,e1,e5,e1we 5];\n\nprimidemp[[2,4]]:=\n''cmulQ''((1/2)*(Id+e1we5),(1/2)*(Id+e2we6) );\nSBgens[[2,4]]:=[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e3we4 ,\n e1we2we3,e1we2we4,e1we3we4,e2we3we4,e1we2we3we4];\n FBgens[[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));\nSBge ns[[5,1]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5,\n \+ e2we3we4,e2we3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBgens[[ 5,1]]:=[Id,e2we3,e2we4,e3we4];\nSBKgens[[5,1]]:=[Id,e2,e5,e2we5];\n\np rimidemp[[6,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5));\nS Bgens[[6,0]]:=[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we6,e4we6, \n e5we6,e2we3we6,e2we4we6,e2we5we6];\nFBgens[[6,0]]:=[ Id,e2we3,e3we5,e2we5];\nSBKgens[[6,0]]:=[Id,e2,e6,e2we6];\n\nprimidemp [[2,6]]:=\n''cmulQ''((1/2)*(Id+e3we4we5),(1/2)*(Id+e1we7),(1/2)*(Id+e2 we8));\nSBgens[[2,6]]:=\n[Id,e1,e2,e3,e4,e5,e6,e1we2,e1we3,e1we4,e1we5 ,e1we6,e2we3,e2we4,e2we5,\n e2we6,e3we6,e4we6,e5we6,e1we2we3,e1we2we4, e1we2we5,e1we2we6,e1we3we6,\n e1we4we6,e1we5we6,e2we3we6,e2we4we6,e2we 5we6,e1we2we3we6,e1we2we4we6,\n e1we2we5we6];\nFBgens[[2,6]]:=[Id,e3,e 3we5,e5];\nSBKgens[[2,6]]:=[Id,e1,e2,e6,e1we2,e1we6,e2we6,e1we2we6];\n \nprimidemp[[3,5]]:=\n''cmulQ''((1/2)*(Id+e1we6),(1/2)*(Id+e2we7),(1/2 )*(Id+e3we8));\nSBgens[[3,5]]:=\n[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4, e1we5,e2we3,e2we4,e2we5,e3we4,\n e3we5,e4we5,e1we2we3,e1we2we4,e1we2we 5,e1we3we4,e1we3we5,e1we4we5,\n e2we3we4,e2we3we5,e2we4we5,e3we4we5,e1 we2we3we4,e1we2we3we5,\n e1we2we4we5,e1we3we4we5,e2we3we4we5,e1we2we3w e4we5];\nFBgens[[3,5]]:=[Id,e4,e5,e4we5];\nSBKgens[[3,5]]:=[Id,e1,e2,e 3,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,e 3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we4,e3we5,e3we6,e4we5,\n e4we6,e5 we6,e2we3we4,e2we3we5,e2we3we6,e2we4we5,e2we4we6,e2we5we6,\n e3we4we5, e3we4we6,e3we5we6,e4we5we6,e2we3we4we5,e2we3we4we6,\n e2we3we5we6,e2we 4we5we6,e3we4we5we6,e2we3we4we5we6];\nFBgens[[6,2]]:=[Id,e2we3,e2we4,e 3we4];\nSBKgens[[6,2]]:=[Id,e2,e5,e6,e2we5,e2we6,e5we6,e2we5we6];\n\np rimidemp[[7,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2 )*(Id+e7we8));\nSBgens[[7,1]]:=\n[Id,e2,e3,e4,e5,e6,e7,e2we3,e2we4,e2w e5,e2we6,e2we7,e3we6,e3we7,e4we6,\n e4we7,e5we6,e5we7,e6we7,e2we3we6,e 2we3we7,e2we4we6,e2we4we7,e2we5we6,\n e2we5we7,e2we6we7,e3we6we7,e4we6 we7,e5we6we7,e2we3we6we7,e2we4we6we7,\n e2we5we6we7];\nFBgens[[7,1]]:= [Id,e2we3,e3we5,e2we5];\nSBKgens[[7,1]]:=[Id,e2,e6,e7,e2we6,e2we7,e6we 7,e2we6we7];\n\n#Real, semi-simple (8 cases)\nprimidemp[[1,0]]:=(1/2)* (Id+e1);\nSBgens[[1,0]]:=[Id];\nFBgens[[1,0]]:=[Id];\nSBKgens[[1,0]]:= SBgens[[1,0]];\n\nprimidemp[[2,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(I d+e2we3));\nSBgens[[2,1]]:=[Id,e2];\nFBgens[[2,1]]:=[Id];\nSBKgens[[2, 1]]:=SBgens[[2,1]];\n\nprimidemp[[3,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/ 2)*(Id+e2we4),(1/2)*(Id+e3we5));\nSBgens[[3,2]]:=[Id,e2,e3,e2we3];\nFB gens[[3,2]]:=[Id];\nSBKgens[[3,2]]:=SBgens[[3,2]];\n\nprimidemp[[0,7]] := ''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we 6),\n (1/2)*(Id+e3we6we7));\nSBgens[[0,7]]:=[Id,e1,e2,e3,e4,e 5,e6,e7];\nFBgens[[0,7]]:=[Id];\nSBKgens[[0,7]]:=SBgens[[0,7]];\n\npri midemp[[4,3]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we5),(1/2)*(Id+e3 we6),\n (1/2)*(Id+e4we7));\nSBgens[[4,3]]:=[Id,e2,e3,e4,e2we3 ,e2we4,e3we4,e2we3we4];\nFBgens[[4,3]]:=[Id];\nSBKgens[[4,3]]:=SBgens[ [4,3]];\n\nprimidemp[[9,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3 we4we5),1/2*(Id+e2we3we6we7),\n (1/2)*(Id+e2we3we8we9),(1/2)* (Id+e2we4we6we8));\nSBgens[[9,0]]:=\n[Id,e2,e3,e4,e5,e6,e7,e8,e9,e2we3 ,e2we4,e2we5,e2we6,e2we7,e2we8,e2we9];\nFBgens[[9,0]]:=[Id];\nSBKgens[ [9,0]]:=SBgens[[9,0]];\n\nprimidemp[[5,4]]:=\n''cmulQ''((1/2)*(Id+e1), (1/2)*(Id+e2we6),(1/2)*(Id+e3we7),\n (1/2)*(Id+e4we8),(1/2)*( Id+e5we9));\nSBgens[[5,4]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3 we5,e4we5,e2we3we4, e2we3we5,e2we4we5,e3we4we5,e2we3we4we5];\nFBgens[[ 5,4]]:=[Id];\nSBKgens[[5,4]]:=SBgens[[5,4]];\n\nprimidemp[[1,8]]:=\n'' cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),1/2*(Id+e2we3we6we7),\n \+ (1/2)*(Id+e2we3we8we9),(1/2)*(Id+e2we4we6we8));\nSBgens[[1,8]] :=[Id,e2,e3,e4,e5,e6,e7,e8,e9,e2we3,e2we4,e2we5,e2we6,e2we7,e2we8,e2we 9];\nFBgens[[1,8]]:=[Id];\nSBKgens[[1,8]]:=SBgens[[1,8]];\n\n#Complex, semi-simple - none\n\n#Quaternionic, semi-simple (5 cases)\nprimidemp [[0,3]]:=(1/2)*(Id+e1we2we3);\nSBgens[[0,3]]:=[Id,e1,e2,e3];\nFBgens[[ 0,3]]:=[Id,e1,e2,e1we2];\nSBKgens[[0,3]]:=[Id];\n\nprimidemp[[1,4]]:= \n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e1we5));\nSBgens[[1,4]]:=[Id ,e1,e2,e3,e4,e1we2,e1we3,e1we4];\nFBgens[[1,4]]:=[Id,e2,e3,e2we3];\nSB Kgens[[1,4]]:=[Id,e1];\n\nprimidemp[[5,0]]:=\n''cmulQ''((1/2)*(Id+e1), (1/2)*(Id+e2we3we4we5));\nSBgens[[5,0]]:=[Id,e2,e3,e4,e5,e2we3,e2we4,e 2we5];\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+e1we 6),(1/2)*(Id+e2we7));\nSBgens[[2,5]]:=[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e 1we4,e1we5,\n e2we3,e2we4,e2we5,e1we2we3,e1we2we4,e1we2 we5];\nFBgens[[2,5]]:=[Id,e3,e3we5,e5];\nSBKgens[[2,5]]:=[Id,e1,e2,e1w e2];\n\nprimidemp[[6,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4 we5),(1/2)*(Id+e6we7));\nSBgens[[6,1]]:=[Id,e2,e3,e4,e5,e6,e2we3,e2we4 ,e2we5,e2we6,e3we6,\n e4we6,e5we6,e2we3we6,e2we4we6,e2 we5we6];\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+e 2we8),\n (1/2)*(Id+e3we9),(1/2)*(Id+e4we5we6w e7));\nSBgens[[7,2]]:=[Id,e2,e3,e4,e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2 we7,\ne3we4,e3we5,e3we6,e3we7,e4we5,e4we6,e4we7,e2we3we4,e2we3we5,e2we 3we6,\ne2we3we7,e2we4we5,e2we4we6,e2we4we7,e3we4we5,e3we4we6,e3we4we7, \ne2we3we4we5,e2we3we4we6,e2we3we4we7];\nFBgens[[7,2]]:=[Id,e4we5,e5we 7,e4we7];\nSBKgens[[7,2]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\n \nprimidemp[[3,6]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we4),\n \+ (1/2)*(Id+e3we5),(1/2)*(Id+e6we7we8we9));\nSBgens[[3,6]]:=[Id,e2, e3,e6,e7,e8,e9,e2we3,e2we6,e2we7,e2we8,e2we9,e3we6,e3we7,\ne3we8,e3we9 ,e6we7,e6we8,e6we9,e2we3we6,e2we3we7,e2we3we8,e2we3we9,e2we6we7,\ne2we 6we8,e2we6we9,e3we6we7,e3we6we8,e3we6we9,e2we3we6we7,e2we3we6we8,\ne2w e3we6we9];\nFBgens[[3,6]]:=[Id,e6we7,e7we9,e6we9];\nSBKgens[[3,6]]:=[I d,e2,e3,e6,e2we3,e2we6,e3we6,e2we3we6];\n\nreturn ([K,dimoverK,struct, primidemp[[p,q]],\n SBgens[[p,q]],FBgens[[p,q]],SBKgens[[p,q]]] );\nend proc:\n##################\nreturn clidata2(a1); #### <<< Retur n from 'clidata'\nend proc: #### <<< End of 'clidata'\n" }}{PARA 258 " " 0 "" {TEXT -1 18 "No. 53. Procedure " }{TEXT 340 10 "Bsignature" } {TEXT -1 313 " finds the signature of the form B assuming that B is a diagonal matrix or a symmetric matrix. It returns a list L with two o r three integers depending on whether B is non-degenerate or degenerat e, that is, L=[p,q] or L=[p,q,d]. Here d = dim(rad B), and p (q) denot es 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 1289 "Bsignatur e:=proc() local curB,Bdiag,pos,neg,deg,i,L;global B;\noptions `Copyrig ht (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: November 5, 2002`;\n########## ###################################\nif nargs=0 then\n if not type( B,matrix) then\n error \"square matric should be assigned to B f irst\"\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 n ot a matrix\"\n else curB:=evalm(args[1]) \n end if;\nelse erro r \"wrong number of arguments. See ?Bsignature for more help.\" \nend \+ if;\nBdiag:=diagonalize(evalm(curB-(curB-linalg[transpose](curB))/2)); \nif not type(Bdiag,diagmatrix) then \n error \"unable to diagonaliz e symmetric part of the input\"\nend if;\nL:=map(signum,[seq(Bdiag[i,i ],i=1..linalg[coldim](Bdiag))]):\nif not type(L,list(integer)) then\n \+ error \"unable to determine signs of expressions %1\",L\nend if;\npo s:=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 do;\nif deg=0 \+ then return [pos,neg] else return [pos,neg,deg] end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 157 "No. 51. Spinor representation of Cl( Q) in S=Cl(Q)f and S=fCl(Q) over the field K of the reals, complexes, \+ or quaternions when Cl(Q) is simple.\nThe procedure " }{TEXT 341 11 "s pinorKrepr" }{TEXT -1 183 " finds matrix representation of any Cliffor d 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 type clipolynom;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 210 "(2 ) the second argument is a list of generators of the minimal ideal S c onsidered as a K-vector space. For standard f equal to clidata()[4] t hese 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 spanning K. For stan dard f equal to clidata()[4] these generators are stored under clidata ()[5]. Matrices computed by 'spinorKrepr' will be expressed in terms \+ of these basis elements of K;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 111 "(4) the fourth argument is a one of th e strings 'left' or 'right' depending whether the ideal is left or rig ht." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 562 "When standard input is used, i.e., the second argument equals cli data()[7] and the third argument equals clidata()[5], the procedure tr ies to use previously computed matrices representing 1-vectors. These matrices are stored as .m files with the names 'matrealL.m', 'matcomp L.m', 'matquatL.m' for real, complex, and quaternionic matrices in the left-regular spinor representation. If the first argument entered bel ongs to Cl(Q) whose 1-vector matrices have been previously computed, t he procedure calls 'matKrepr' which makes use of these pre-computed ma trices." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 470 "Typical use: dim:=4:B:=linalg[diag](1,-1,-1,-1):clibasis:=cbas is(dim):data:=clidata():\n f:=data[4]:\n \+ sbasis:=minimalideal(clibasis,f,'left');\n \+ fbasis:=Kfield(sbasis,f);\n Kb asis:=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],'left');\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 5376 "spinorKrepr:=proc(a1::\{clibasmon ,climon,clipolynom,numeric\},\n a2::list(\{clibasmon, climon,clipolynom\}),\n a3::list(\{clibasmon,climon,c lipolynom\}),\n a4::\{string,symbol\})\nlocal i,j,k,r eprdim,r,a,FBgens,eq,hbasis,g,terms,sys,vars,sol,M,pqsig,pq,\n fl ag_left,data,Kbasis,f,v,pqmod8,n,expr,flag_simple;\nglobal B,_prolevel ,_shortcut_in_spinorKrepr,matrealL,matrealR,matcompL,matcompR,matquatL ,matquatR;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: No vember 5, 2002`;\n#############################################\nif no t type(B,diagmatrix) then \n error \"bilinear form B must be defined as diagonal matrix\" \nelse pq:=Bsignature() \nend if;\n############# #####################\nif pq[1]-pq[2]=1 mod 4 then flag_simple:=false \+ else flag_simple:=true end if;\n##################################\nif maxindex(a1) > linalg[coldim](B) then\n error \"maximum index %1 fo und in input is greater than the size %2 of the current bilinear form \+ B\", maxindex(a1),linalg[coldim](B) \nend if;\n####################### ###########\nhbasis:=a2:FBgens:=a3:reprdim:=nops(hbasis):n:=nops(FBgen s):\n##################################\nif member(a4,\{'left',\"left \"\}) then flag_left:=true elif\n member(a4,\{'right',\"right\"\}) t hen flag_left:=false else\n error \"last argument expected to be 'le ft' or 'right' but received %1 instead\",a4\nend if; \n############### #########################################################\n#This proce dure gives faithful representations when Cl(p,q) is simple\n#and unfai thful when Cl(p,q) is semi-simple. In order to get faithful\n#represen tations in this last case, use 'matKrepr' or use this procedure\n#as s hown in examples.\n################################################### #####################\n#if flag_simple then\nif a1=Id then return lin alg[diag](1$reprdim) elif\n a1=-Id then return linalg[diag](-1$reprd im) elif\n type(a1,numeric) then return linalg[diag](a1$reprdim) \ne nd if;\n#else\n#if a1=Id then return cdfmatrix([linalg[diag](1$reprdi m)$2]) elif\n# a1=-Id then return cdfmatrix([linalg[diag](-1$reprdim )$2]) elif\n# type(a1,numeric) then return cdfmatrix([linalg[diag](a 1$reprdim)$2]) \n# end if;\n# end if;\n#when _shortcut_in_spinorKrepr \+ is false, 'matKrepr' is not used\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(pqm od8,\{0,1,2\}) and not flag_left then\n #if not assigned(matrealR ) then readlib(matrealR) end if;\n pqsig:=map(op,[indices(matrea lR)]) \n elif member(pqmod8,\{3,7\}) and flag_left then \n #if \+ not assigned(matcompL) then readlib(matcompL) end if;\n pqsig:=m ap(op,[indices(matcompL)]) \n elif member(pqmod8,\{3,7\}) and not fl ag_left then\n #if not assigned(matcompR) then readlib(matcompR) \+ end if;\n pqsig:=map(op,[indices(matcompR)]) \n elif member(pq mod8,\{4,5,6\}) and flag_left then \n #if not assigned(matquatL) \+ then readlib(matquatL) end if;\n pqsig:=map(op,[indices(matquatL )]) \n elif member(pqmod8,\{4,5,6\}) and not flag_left then\n # if not assigned(matquatR) then readlib(matquatR) end if;\n pqsig :=map(op,[indices(matquatR)]) \n end if;\n########################## ###########\n if member(pq,pqsig) then \n data:=clidata(pq ):f:=eval(eval(data[4])):\n g:='g': \n if flag_left the n Kbasis:=[seq(cmulQ(g,f),g=data[7])] \n else Kbasi s:=[seq(cmulQ(f,g),g=data[7])] \n end if; \n if hbasis=Kbasi s then\n if FBgens=data[6] then return matKrepr(a1,a4) end if; \n end if;\n end if;\nend if;\n########################### ##########\n#Continue finding the matrix\na:='a':j:='j':k:='k':\nif fl ag_left then\n expr:=add(add(a[j,k]*cmulQ(hbasis[j],FBgens[k]),j=1.. reprdim),k=1..n);\n for j from 1 to reprdim do r[j]:=add(a[j,k] * FB gens[k],k=1..n) end do; \n for i from 1 to reprdim do\n eq:= expand(cmulQ(a1,hbasis[i])-expr);\n terms:=cliterms(eq);\n \+ eq:=clicollect(eq,terms);\n sys:=\{coeffs(eq,terms)\}:\n \+ vars:=\{seq(seq(a[j,k],k=1..n),j=1..reprdim)\};\n sol:=solve(sys ,vars);\n if sol=NULL then \nerror \"unable to find matrix due i nput error: check if the last argument matches the one previously used in 'spinorKbasis'\"\n end if; \n v[i]:=convert([seq(subs( sol,r[j]),j=1..reprdim)],vector);\n end do:\nM:=linalg[transpose](li nalg[stackmatrix](seq(eval(v[i]),i=1..reprdim)));\nreturn subs(Id=1,ev alm(M));\nelse \n expr:=add(add(a[j,k]*cmulQ(FBgens[k],hbasis[j] ),j=1..reprdim),k=1..n);\n for j from 1 to reprdim do r[j]:=add(a[j, k] * FBgens[k],k=1..n) end do; \n for i from 1 to reprdim do \+ \n eq:=expand(cmulQ(hbasis[i],a1)-expr);\n terms:=cliterm s(eq);\n eq:=clicollect(eq,terms);\n sys:=\{coeffs(eq,term s)\}:\n vars:=\{seq(seq(a[j,k],k=1..n),j=1..reprdim)\};\n \+ sol:=solve(sys,vars);\n if sol=NULL then \nerror \"unable to fin d matrix due to input error: check if the last argument matches the on e previously used in 'spinorKbasis'\"\n end if; \n v[i]:=c onvert([seq(subs(sol,r[j]),j=1..reprdim)],vector);\n end do:\nM:=lin alg[transpose](linalg[stackmatrix](seq(eval(v[i]),i=1..reprdim)));\nre turn subs(Id=1,evalm(M));\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 52. Procedure " }{TEXT 342 5 "rmulm" }{TEXT -1 110 " extends the following multiplications to matrix entries: cmul, cmulQ , wedge, omul, `&r`, `&*`\n " }}{PARA 258 "" 0 "" {TEXT -1 271 "In this last case, the commutative multiplication `*` is appl ied to the matrix entries. It takes three arguments or four arguments . If the fourth argument is used, it is either of type name/symbol/arr ay/matrix or a numeric multiple of such type, for example, K or -K. \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 90 "T o apply Clifford multiplication 'cmul[B]' to matrix entries enter one \+ of the following: " }}{PARA 258 "" 0 "" {TEXT -1 143 "rmulm(M1, M2, c mul); rmulm(M1,M2,cmul,B);rmulm(M1,M2,cmul,K);rmulm(M1,M2,cmul,-K);\n& cm(M1, M2); &cm[B](M1,M2);&cm[K](M1,M2);&cm[-K](M1,M2); \n" }}{PARA 258 "" 0 "" {TEXT -1 89 "To apply Clifford multiplication 'cmulQ[B]' t o matrix entries enter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 235 "rmulm(M1, M2, cmulQ); rmulm(M1,M2,cmulQ,B);rmulm(M1,M2,c mulQ,K);rmulm(M1,M2,cmulQ,-K);\n&cQm(M1, M2); &cQm[B](M1,M2);&cQm[K](M 1,M2);&cQm[-K](M1,M2); \n\nTo apply wedge multiplication 'wedge' to \+ matrix entries enter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 60 "rmulm(M1, M2, `&w`); M1 &wm M2; rmulm(M1, M2, wedge); " } }{PARA 258 "" 0 "" {TEXT -1 113 "\nTo apply some generic possibly non- commutative multiplication `&r` to matrix entries enter one of the fol lowing:" }}{PARA 258 "" 0 "" {TEXT -1 37 "rmulm(M1, M2, `&r`); M1 & rm M2; " }}{PARA 258 "" 0 "" {TEXT -1 98 "\nTo apply standard commut ative scalar multiplication to matrix entries enter one of the followi ng:" }}{PARA 258 "" 0 "" {TEXT -1 39 "rmulm(M1, M2, `&*`); M1 &* \+ M2; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 70 "Similarly for matrices with quaternionic entries we have as fol lows: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 89 "To apply quaternionic multiplication 'qmul' to matrix entries e nter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 72 "rmulm(M1, M2, `&q`); M1 &qm M2; rmulm(M1,M2,qmul);\n\nTypical use: " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 73 "M1 := linalg[matrix](2, 2, [Id + e1we2, e2 + e3, e1 - e2, Id + e2we3]); " }}{PARA 258 "" 0 "" {TEXT -1 137 "M2 := linalg[matrix](2, 2, [Id + e2w e3, e3 + e4, e1 - e2, Id + e1we3]); \n\nM1 := linalg[matrix](2, 2, [I d + 2*qi + 3*qj, qi, qi + qj]); " }}{PARA 258 "" 0 "" {TEXT -1 58 "M2 := linalg[matrix](2, 2, [Id + qi, qj, qk, Id - qi]); \n" }}{PARA 258 "> " 0 "" {MPLTEXT 1 0 7038 "rmulm:=proc(a1::\{list(matrix),dfmatr ix,matrix,clipolynom,cliscalar,clibasmon,climon\},\n a2::\{ list(matrix),dfmatrix,matrix,clipolynom,cliscalar,clibasmon,climon\}, \n a3::\{name,function,procedure,symbol\}) \nlocal ar1,ar2, L,newL,m1,m2,r1,r2,c1,c2,i,j,k,M,reset_prolevel,coB,nameB,lname,tail,o ut;\nglobal _prolevel, `&r`;\noptions `Copyright (c) 1995-2003 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\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 lname:=`B`: \nelif n args=4 then\n if type(eval(args[4]),\{name,symbol,matrix,array\}) t hen\n coB:=1:\n nameB:=args[4];\n lname:=args[4];\n \+ elif type(eval(args[4]),`&*`(numeric,\{name,symbol,matrix,array\})) then\n coB:=op(select(type,\{op(args[4])\},numeric));\n n ameB:=op(remove(type,\{op(args[4])\},numeric));\n lname:=args[4] :\n else \n error \"wrong type of fourth argument %1 in rmulm \",args[4] \n end if;\nelse\n error \"three or four arguments exp ected in rmulm\"\nend if;\n################################\ntail:=op( subsop(1=NULL,subsop(1=NULL,[args])));\n############################## ##\n#return (a1,a2,a3,coB,nameB,lname,tail);\n######################## ########\nif _prolevel then reset_prolevel:=true:\n \+ _prolevel:=false:\n else reset_prolevel:=false\nend if ; \n################################\nif type(a1,matrix ) and not type(a1,\{dfmatrix,climatrix,cliscalar\}) and \n type(a2 ,matrix) and not type(a2,\{dfmatrix,climatrix,cliscalar\})\nthen \n \+ _prolevel:=reset_prolevel:\n return evalm(a1 &* a2) \n end if;\n ################################\nif type(a1,list(matrix)) and type(a2 ,list(matrix)) then \n if nops(a1)<>nops(a2) then error \"received l ists of unequal lengths\" \n else\n i:='i':\n _prolevel:=r eset_prolevel:\n return [seq(procname(a1[i],a2[i],tail),i=1..nops (a1))]\n end if;\nend if;\n################################\nif type (a1,dfmatrix) and type(a2,dfmatrix) then\n return cdfmatrix(procname (ddfmatrix(a1),ddfmatrix(a2),tail))\nend if;\n######################## ########\nif type(a1,\{clipolynom,cliscalar,clibasmon,climon\}) then \+ \n if type(a2,list(matrix)) then return (map2(procname,args)) \n e lif type(a2,dfmatrix) then \n return subs(Id=1,convert(map2(pro cname,a1,ddfmatrix(a2),tail),dfmatrix))\n end if\nend if;\n######### #######################\nif type(a2,\{clipolynom,cliscalar,clibasmon,c limon\}) then \n if type(a1,list(matrix)) then return map(procname,a rgs) \n elif type(a1,dfmatrix) then \n return subs(Id=1,conve rt(map(procname,ddfmatrix(a1),a2,tail),dfmatrix))\n end if\nend if; \n################################\nif not member(a3,\{`&*`,`&r`,Clipl us:-climul,cmul,cmulQ,wedge,qmul,Octonion:-omul\}) then \n error \"t hird argument must be one of the following: cmul, cmulQ, wedge, qmul, \+ omul, &*, &r but received %1 instead\",a3 \nend if;\n################# ###############\nif member(a3,\{`&*`\}) and \n (type(a1,\{clibasmon, climon,clipolynom,climatrix\}) or\n type(a2,\{clibasmon,climon,clip olynom,climatrix\})) then\nerror \"it makes no sense to apply commutat ive multiplication &* to non-commuting elements %1 and %2\",a1,a2 \nen d if;\n################################\nar1:=evalm(a1):ar2:=evalm(a2) :\nif not type(a1,matrix) and type(ar1,matrix) then \n _prolevel :=reset_prolevel: \n return procname(ar1,a2,tail) \nend if;\ni f not type(a2,matrix) and type(ar2,matrix) then \n _prolevel:=re set_prolevel:\n return procname(a1,ar2,tail) \nend if;\n######## ###################################################################### ######\n##If both inputs are of type clipolynom, climon, or clibasmon \+ do the following:\n################################################### #################################\nif (type(evalm(a1),\{clibasmon,clim on,clipolynom\}) \n and \n type(evalm(a2),\{clibasmon,climon,cli polynom\}))\nthen \n if member(a3,\{Cliplus:-climul,cmul,cmulQ\}) t hen\n _prolevel:=reset_prolevel: \n return simplify(reorde r(a3[lname](a1,a2)))\n elif \n member(a3,\{wedge,qmul,omul\}) then\n _prolevel:=reset_prolevel:\n if _warnings_flag and n args=4 then\n WARNING(sprintf(\"ignoring fourth argument %a\", lname))\n end if; \n #return simplify(reorder(a3(a1,a2)) )\n return eval('simplify'('reorder'(a3(a1,a2))));\n else\n \+ _prolevel:=reset_prolevel: \n return simplify(a3[lname](a1,a2 )) \n end if;\nend if; \n########################################## #\n##If m1 is a polynomial and m2 is a matrix:\n###################### #####################\nif type(evalm(a1),\{clibasmon,climon,clipolynom ,cliscalar\}) \n and \n type(a2,matrix)\n then \n if member( a3,\{qmul\}) then \n m2:=map(eval,a2) \n else \n m2: =a2 \n end if;\n L:=map(displayid,convert(m2,'mlist'));\n new L:=[]:\n for i from 1 to nops(L) do newL:=[op(newL),a3[lname](a1,L[i ])] end do;\n if not member(a3,\{qmul\}) then\n _prolevel:=rese t_prolevel: \n return map(displayid,map(simplify,linalg[matrix] (linalg[rowdim](a2),linalg[coldim](a2),newL)))\n else \n _prole vel:=reset_prolevel: \n return map(simplify,linalg[matrix](lina lg[rowdim](a2),linalg[coldim](a2),newL))\nend if:\nend if: \n######### ##############################\n#a2 is a polynomial and a1 is a matrix \n#######################################\nif type(evalm(a2),\{clibasm on,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 _pr olevel:=reset_prolevel:\n return map(simplify,linalg[matrix](linalg[ rowdim](a1),linalg[coldim](a1),newL))\nelse\n _prolevel:=reset_prole vel: \n return map(simplify,linalg[matrix](linalg[rowdim](a1),linalg [coldim](a1),newL))\nend if:\nend if: \n############################## ########################\n##If both inputs are of type matrix, do the \+ following:\n######################################################\nif member(a3,\{qmul\}) then \n m1:=evalm(map(eval,a1));m2:=evalm(map(ev al,a2))\nelse \n m1:=evalm(a1);m2:=evalm(a2); \nend if;\nm1:=displayi d(m1):m2:=displayid(m2):\nr1:=linalg[rowdim](m1):r2:=linalg[rowdim](m2 ):\nc1:=linalg[coldim](m1):c2:=linalg[coldim](m2):\nif c1 <> r2 then \+ \n error \"matrices have incompatible dimensions and cannot be multi plied\" \nend if;\nM:=linalg[matrix](r1,c2,[]);\nk:='k':\nfor i from 1 to r1 do\nfor j from 1 to c2 do\nif a3=`&*` then \n M[i,j]:=sum(m1[ i,k] * m2[k,j],k=1..c1) \nelse \n M[i,j]:=map(simplify,add(a3[lname] (m1[i,k],m2[k,j]),k=1..c1)) \nend if;\nod end do;\n_prolevel:=reset_pr olevel:\nif member(a3,\{Cliplus:-climul,cmul,cmulQ,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;\nend proc:" }}{PARA 0 "" 0 "" {TEXT 261 9 "\nNo. 53: " }{TEXT 343 5 "`&cm`" }{TEXT 344 333 " de notes multiplication of matrices when Clifford product of Cl(B) is app lied 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 multiplication of matrices when Clifford product of \+ Cl(Q) is applied to matrix 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 &cQm[''-K''](p1,p2). Procedure can also be used \+ withouht the index as in &cQm(p1,p2).\n(Has been moved to Clifford:-se tup).\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 274 8 "No. 55: " } {TEXT 347 5 "`&wm`" }{TEXT 348 131 " denotes multiplication of matrice s when wedge/exterior product 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 matr ices when quaternion product 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 matr ices when non-associative octonionic multiplication is applied to the \+ matrix entries.\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT 263 8 "No. 58: " }{TEXT 353 5 "`&rm`" }{TEXT 354 217 " deno tes multiplication of matrices when a generic associative but possibly not commutative `&r` product is applied to matrix entries. It can tak e index. User needs to define procedue `&r` in a similar mannet to `&c `." }{TEXT -1 1 "\n" }{TEXT 479 37 "(Has been moved to Clifford:-setup ).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 59. Procedure " }{TEXT 355 8 "matKrepr" }{TEXT -1 261 " uses previously computed matrices of basi s 1-vectors to find a matrix representation in a minimal left or right ideal of any Clifford polynomial in the given Clifford algebra Cl(Q). Depending on the signature [p,q] of the quadratic form Q, these matr ices 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; \nquaternionic if (p - q) mod 8 is 4, 5, or 6." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 311 "The \+ real matrices of 1-vectors in dimensions from 2 to 8 have been compute d with the procedure 'spinorKrepr' in minimal left ideals and stored i n a form of a table called 'matrealL' in Maple library. The indices of the table are given by the signature [p,q]. To see matrices in a spec ific signature [p,q], enter" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 17 ">matrealL([p,q]);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 69 "(assuming, of course, t hat the matrices for this signature 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 'matco mpL.m' and for quaternionic matrices in dimensions from 2 to 8 which a re stored in the file 'matquatL.m'.\n\nSimilarly for matrices represen ting basis 1-vectors in right minimal ideals; in this case correspondi ng files are: 'matrealR.m', 'matcompR.m', and 'matquatR.m'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 316 "Matrices r epresenting Clifford polynomials are generally computed with 'matKrepr ' much faster than with 'spinorKrepr' because the former is a linear p rocedure that uses matrix multiplication 'rmulm' to compute matrices r epresenting basis monomials.\n\nNOTE: This procedure can now handle se mi-simple Clifford algebras." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 13 "Typical use: " }}{PARA 258 "" 0 "" {TEXT -1 92 "to see matrices representing 1-vectors in a 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 representing a Clifford polynomial p \+ for the current B in a left minimal ideal enter:\n" }}{PARA 258 "" 0 " " {TEXT -1 36 ">matKrepr(p); \n>matKrepr(p,'left');\n" }}{PARA 0 "" 0 "" {TEXT 256 313 "to find a matrix representing a Clifford polynomial \+ p for the current B in a right minimal ideal enter:\n\n>matKrepr(p,'ri ght');\n\nto see matrices representing 1-vectors in a minimal left or \+ right ideal when Q has the signature [p,q], enter:\n\n>matKrepr([p,q]) ;\n>matKrepr([p,q],'left');\n\nor\n\n>matKrepr([p,q],'right');" }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4866 "m atKrepr:=proc() \nlocal mindex,Bsize,dim,ind,pq,pqsig,matdata,i,a1,a2, dimrepr,ans,pqmod8,pqmod4,matdatatable,\n m,flag_simple,k,L,t,co, x,reprmulm;\nglobal B,matrealL,matcompL,matquatL,matrealR,matcompR,mat quatR:\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Novemb er 5, 2002`;\n#############################################\n#Checking argument types\nif not member(nargs,\{0,1,2\}) then \n error \"wron g 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,cli polynom\}) then\n error \"first argument must be of type 'list', cli basmon, climon, or clipolynom but received one of type %1\",whattype(a rgs[1]) \nend if;\nif nargs=2 and not member(args[2],\{'left','right' \}) then \n error \"second argument, when used, must be 'left' or 'r ight', 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\}) th en\n if not type(B,matrix) then \n error \"matrix must be assi gned to B\"\n elif not type(B,'diagmatrix') then\n error \"bi linear form B must be diagonal\"\n else \n pq:=Bsignature(); \n pqmod8:=(pq[1]-pq[2]) mod 8;\n pqmod4:=(pq[1]-pq[2]) mo d 4;\n flag_simple:=evalb(pqmod4<>1);\n end if;\nelif type(a1 ,list) then pq:=a1:pqmod8:=(pq[1]-pq[2]) mod 8 \nelse error \"wrong ar gument(s)\"\nend if;\n##############################################\n if type(a1,\{clibasmon,climon,clipolynom\}) then\n mindex:=maxindex( a1):Bsize:=linalg[coldim](B):\n if mindex > Bsize then\n error \+ \"input error: maximum index in your input %1 is greater than the size %2 of the currently defined bilinear form B\",mindex,Bsize \n end i f;\nend if;\nif nargs=1 or nargs=0 then a2:='left' else a2:=args[2] en d if;\n#read in appropriate data file: \nif member(pqmod8,\{0,1,2\}) t hen\n if a2='left' then \n #if not assigned(matrealL) the n readlib(matrealL) end if;\n matdatatable:=matrealL:\n \+ else\n #if not assigned(matrealR) then readlib(matrealR) end \+ if;\n matdatatable:=matrealR:\n end if;\nelif member(pqmo d8,\{3,7\}) then\n if a2='left' then\n #if not assigned(m atcompL) then readlib(matcompL) end if;\n matdatatable:=matco mpL:\n else \n #if not assigned(matcompR) then readlib(ma tcompR) end if;\n matdatatable:=matcompR:\n end if;\neli f member(pqmod8, \{4,5,6\}) then\n if a2='left' then\n #i f not assigned(matquatL) then readlib(matquatL) end if;\n mat datatable:=matquatL:\n else\n #if not assigned(matquatR) \+ then readlib(matquatR) end if;\n matdatatable:=matquatR:\n \+ end if; \n else error \"wrong value of pqmod8: %1\",pqmod8 \nend if ;\n#######################################\npqsig:=map(op,[indices(mat datatable)]);\nif not member(pq,pqsig) then\n error \"matrices for s ignature %1 in %2 minimal ideal have not been computed yet\",pq,a2 \n end if;\n#######################################\nmatdata:=matdatatabl e[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(matdata[1]));\nif dim<>nops(matdata) th en \n error \"size of B is different 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 return subs(Id=1,reprmulm(args[1..(n args-2)],rmulm(args[nargs-1],args[nargs],`cmulQ`))) \n end if;\nend proc:\n########################################\nm:=array(1..nops(mat data)):\nfor i from 1 to nops(matdata) do m[i]:=rhs(matdata[i]) end do ;\nif type(a1,clibasmon) then\n ind:=Clifford:-extract(a1,'integers' ): \n if a1='Id' then \n if flag_simple then \n return \+ linalg[diag](1$dimrepr) \n else \n return convert([lina lg[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[in d])) \n else return subs(Id=1,reprmulm(seq(evalm(m[ind[i]]),i=1..nop s(ind)))) \n end if:\nend if;\n##################################### ####\nans:=clilinear(a1,'K'):\nif flag_simple then \n return subs(Id =1,evalm(eval(subs(K=procname,ans)))) \nend if;\nans:=eval(subs(K=proc name,ans));\nif type(ans,`+`) then ans:=[op(ans)] elif\n type(ans,`* `) then ans:=[ans] else\n error \"unexpected type in matKrepr\" \nen d 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;\nans:=L[1]:\nfor k from 2 to nops(L) do \nans:=adfmatrix(ans,L[k]) end do:\nreturn evalm(ans);\nend proc:\n" } }{PARA 258 "" 0 "" {TEXT -1 25 "No. 60. Sorting function " }{TEXT 376 7 "bygrade" }{TEXT -1 789 ": it sorts a list of Clifford basis monomia ls, Clifford monomials, or Clifford polynomials. Basis monomials and C lifford monomials are sorted by grade; in case of a tie it sorts by le xicographic order based on the basis monomials. However, basis monomia ls are put before Clifford monomials. If any of the elements is a Clif ford polynomial, then ties are resolved by sorting by the weight of ea ch element (defined as the sum of the grades of all terms) and then by then number of Clifford basis monomials in each expression. It return s true or false in each case, and can be used in sorting a list of bas is monomials, Clifford monomials, and Clifford polynomials in the cons truction 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 1985 "bygrade:=proc(a1::\{clibasmon,climon,clipolynom\} ,\n a2::\{clibasmon,climon,clipolynom\}) \nlocal flag1,fl ag2,flag11,flag22,p1,p2,n1,n2,c1,c2,x,w1,w2;\noptions `Copyright (c) 1 995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: November 5, 2002`;\n################## ###########################\nif type(a1,clibasmon) then p1:=a1;\n \+ flag1:=true:\n flag11: =true:\n n1:=Clifford:-extract(p1): \n el if type(a1,climon) then p1:=op(cliterms(a1));\n \+ flag1:=true:\n flag11:=false:\n \+ n1:=Clifford:-extract(p1): \n else p1:=a1;\n \+ flag1:=false:\nend if;\nif type(a2,clibasmon) then p2:=a2;\n \+ flag2:=true:\n flag22:=tr ue:\n n2:=Clifford:-extract(p2): \n elif \+ type(a2,climon) then p2:=op(cliterms(a2));\n \+ flag2:=true:\n flag22:=false:\n \+ n2:=Clifford:-extract(p2): \n else p2:=a2;\n f lag2:=false:\nend if;\nx:='x':\nif flag1 and flag2 then\n if nops(n1 )nops(n2) then return fal se\n else \n if evalb(flag11 and flag22) then return lexorder(p 1,p2)\n elif evalb(flag11 and not flag22) then return lexorder (p1,p2)\n elif evalb(not flag11 and flag22) then return not le xorder(p2,p1);\n else return true\n end if;\n end if; \+ \nelse \n n1:=maxgrade(p1):\n c1:=cliterms(p1):\n w1:=add(maxgr ade(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 i f nops(c1)<=nops(c2) then return true else return false end if;\n \+ else if w1 " 0 "" {MPLTEXT 1 0 2121 "commutingelements:=proc(a1::list(clibasmon)) \nloca l g,groupgens,L,L2,numfact,f,flag1,flag2,flag3,gen,p,q,i;\nglobal B;\n options `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: November 5, 20 02`;\n#############################################\nif not type(B,mat rix) then \n error \"matrix must be assigned to B\"\nend if;\nif not type(B,'diagmatrix') then \n error \"the bilinear form B is not dia gonal as expected\" \nend if;\np:=Bsignature(B)[1]:q:=Bsignature(B)[2] :\nnumfact:=q-RHnumber(q-p):\nflag1:=member(Id,a1):\nL:=remove(member, a1,[Id]):\n#return a1 if it was [Id]\nif L=[] then return args end if; \n#return a1 if had one element of square 1 or [] if the square <>1 \+ \nif nops(L)=1 then\n if cmul(L[1],L[1])=Id then return L\n els e return [] \nend if;\nend if;\n#First, sort the list\nL:=sort(L,bygra de):\n#Find first element of square 1 mod Id\nflag2:=false:L2:=[]:grou pgens:=[]:\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:\n L:=remove(member,L,[op(L2),op(groupgens)]);\nif L=[] then \n if flag 1 then \n return [Id] else return groupgens \n end if;\nend if; \nif nops(groupgens)=numfact then \n return (sort(groupgens,bygrade )) end if;\n#Find commuting elements with square 1 mod Id in the speci fied list of basis monomials\nfor g in L while nops(groupgens)0)) \n then groupgens:=[op(groupgens),g] \n end if;\nen d if:\nend do:\nif groupgens=[] then return args else return sort(grou pgens,bygrade) end if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 " No. 62. Procedure " }{TEXT 378 16 "factoridempotent" }{TEXT -1 369 " \+ can factor the given idempotent e into a product of N elements of the \+ type (1/2)*(Id+e[i]), i=1..N, where \{e[i],i=1..N\} is a set of commu ting 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: factoridempotent(f); #here f is expecte d to be an idempotent\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1736 "factor idempotent:=proc(a1::idempotent) \nlocal T,ee,i,L,flag,flag1,flag2,b1b 2,b1,b2,ans;\nglobal B;\noptions `Copyright (c) 1995-2003 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: November 5, 2002`;\n####################################### ######\nif a1=Id then return Id end if;\nif not type(B,matrix) then \n error \"matrix must be assigned to B\"\nend if;\nif not type(B,'dia gmatrix') then \n error \"the bilinear form B is not diagonal as exp ected\" \nend if;\nee:=eval(a1):\nL:=sort(remove(member,convert(cliter ms(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,bygra de);\nfor b1 in L while flag2 do\nfor b2 in remove(member,L,[b1]) whil e flag2 do\n b1b2:=cmulQ(b1,b2):\n if member(b1b2,L) then flag2: =false;\n L:=remove(member,L,[b1b2]) end if; \n if member(-b1b2,L) then flag2:=false;\n \+ L:=remove(member,L,[-b1b2]) end if;\n if flag2 then flag1:=false \+ end if;\nod od end do: \nL:=commutingelements(L);\nif nops(L)=1 then \+ \n ans:=(1/2)*(Id+L[1]);\n if displayid(a1-ans)=0 then return ans \+ else return a1 end if;\nend if;\nL:=sort(L,bygrade);\ni:='i':\nans:='c mulQ'(seq((1/2)*(Id+L[i]),i=1..nops(L)));\nif eval(ans)-a1=0 then retu rn (ans) end if;\n#try another sign permutation\nfor i from 1 to nops( L) do\n L||i:=[L[i],-L[i]]\nend do:\nT:=combinat[cartprod]([seq(L|| i,i=1..nops(L))]):\nflag:=false:\nwhile not T[finished] and not flag d o \nL:=T[nextvalue]();\nans:='cmulQ'(seq((1/2)*(Id+L[i]),i=1..nops(L)) );\nif eval(ans)-a1=0 then flag:=true:return ans end if;\nend do:\n#re turn unfactored\nreturn a1;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 63. Procedure " }{TEXT 379 11 "makealiases" }{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 dimension of the vector spa ce V. A practical limitation on p is of course the amount of memory M aple will allocate to store these aliases since every basis monomial, \+ not necessarily written in the standard order, will be aliased. This \+ procedure is intended to be used when p < 5 although it can be used al so when p < 10. Remember that to unalias e12 one needs to either rest art Maple or simply assign e12:='e12'.\n\nAs a memory saving feature, \+ option 'ordered' (or \"ordered\") may be entered as a second parameter . If the second parameter is used, aliases are created only for monomi als with ordered indices, for example, e12 will 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 multiplication can be done using these aliases.\n\nTypical use: \n\n>makealiases(3);\n>eval(%);\n" }} {PARA 258 "" 0 "" {TEXT -1 41 "or\n\n>makealiases(3,'ordered');\n>eval (%);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 802 "makealiases:=proc(a1::po sint,a2::\{symbol,string\}) \nlocal L,i,k,l,K,s;\noptions `Copyright ( c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`,remember;\ndescription `Last revised: November 5, 2002`;\n##### ########################################\nif not a1>1 then \n error \+ \"first parameter must be a positive integer larger than one\" \nend i f;\nif nargs=2 and not member(a2,\{'ordered',\"ordered\"\}) then\n e rror \"second optional parameter, when used, must be 'ordered'\" \nend if;\nk:='k':l:='l':i:='i':\nL:=[seq(op(combinat[choose]([seq(i,i=1..a 1)],k)),k=2..a1)];\nif nargs=1 then \n K:=[seq(op(combinat[permute]( l)),l=L)];\n s:=seq(cat(e,op(K[i]))=makeclibasmon(K[i]),i=1..nops(K) )\nelse\n s:=seq(cat(e,op(L[i]))=makeclibasmon(L[i]),i=1..nops(L))\n end if;\nreturn 'alias'(s)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 64. Procedure " }{TEXT 380 4 "cinv" }{TEXT -1 1285 " calculate s a symbolic inverse of any Clifford polynomial p in the given Cliffor d algebra Cl(B) or in its subalgebra. The procedure determines a basi s for the smallest subalgebra of Cl(B) in which the inverse might exis t. For example, if the polynomial p contains only even grades, then t he inverse is sought in an even subalgebra of Cl(B); otherwise, the in verse is sought in a Clifford algebra over a vector space V whose dime nsion equals tha maximum index in p. \n\nIf the bilinear form B is no t assigned then every Clifford polynomial in Cl(B) has a symbolic inve rse. If the bilinear form B is assigned then not every element in Cl(B ) has the inverse. For example, nilpotent and non-trivial idempotent \+ elements have no inverses. Elements p such that p &c p = a*p for som e 'cliscalar' also have no inverses (these elements are called here 'a lmost 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 message. Otherwise it ret urns 'NULL'.\n\nThis procedure can be used with a second optional argu ment K of type symbol, name, matrix , or array. In that case, it compu tes the inverse in Cl(K). The seconf argument can also be -K, or any n umeric 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); ci nv(e1 + 2*e2,-K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4208 "cinv:=pr oc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) \nlocal p,pp,pinv,mi ndex,cinv11,s,aaa,flagB,flagBdiag,S,lname,flagindexed;\nglobal B,_warn ings_flag;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`,remember;\ndescription `Last re vised: November 5, 2002`;\n########################################### ##\nif nargs=1 then\n lname:=`B`;\n flagindexed:=false:\nelif na rgs=2 and type(args[2],\{symbol,name,array,matrix,`&*`(algebraic,name) \}) then\n lname:=args[2];\n flagindexed:=true:\nelse error \"on ly one or two arguments are expected\"\nend if;\n##################### #######\ncinv11:=proc(a1,lname)\nlocal i,d,dbasis,N,u,xm,v,uv,vu,vars, sys,L1,v1,nontrivial;\nglobal evenelement;\n nontrivial:=proc(S::\{s et(\{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(istrivial,S)\n \+ end proc: \ni:='i':\nd:=maxindex(a1):\nif type(a1,'evenel ement') then dbasis:=cbasis(d,'even')\n else \+ dbasis:=cbasis(d) \nend if:\nN:=nops(dbasis):\nu:=clicollect(reorder(a 1)):\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,dba sis)\};\nsys:=nontrivial(sys); #eliminate trivial equations\nL1:=solve (sys,vars);\nif L1=NULL then return (NULL) else \nv1:=subs(L1,v);\nv1: =reorder(v1):\nv1:=clicollect(v1):\nv1:=map(normal,v1);\nreturn (eval( v1)): \nend if;\nend proc:\n#####################################\nif \+ type(a1,cliscalar) then\n if a1<>0 then return 1/a1 else error \"0 h as no inverse\" end if;\nend if;\nmindex:=maxindex(a1);\nif mindex=0 t hen return Id/scalarpart(a1) end if;\np:=simplify(reorder(a1)):\np:=di splayid(p):\npinv:=cinv11(p,lname);\nif evalb(pinv<>NULL) then return \+ pinv end if; \n#####################################\nflagB:=type(eval m(lname),matrix):\nif not flagB then return \"unable to find inverse o f %1\",a1 end if;\n#####################################\nif _warnings _flag then\n WARNING(`testing why entered argument has no inverse... `)\nend if;\n#Checking these special cases only when lname is assigned a matrix:\ns:='s':aaa:='aaa':\nflagBdiag:=type(evalm(lname),diagmatri x):\n#######################################\n###Checking if element a 1 is nilpotent\n#######################################\nif type([p,ln ame],nilpotent) then\n if flagBdiag then \n error \"element %1 \+ is nilpotent in signature %2 and as such it has no inverse\",a1,Bsigna ture(lname) \n else\n error \"element %1 is nilpotent in curren t %2 and as such it has no inverse\",a1,lname \n end if;\nend if;\n# ######################################\n###Checking if element a1 is i dempotent\n#######################################\nif not member(p,\{ Id\}) and type([p,lname],idempotent) then\n if flagBdiag then \nerro r \"element %1 is an idempotent in signature %2 and as such it has no \+ inverse\",a1,Bsignature(lname)\n else \nerror \"element %1 is an ide mpotent in current %2 and as such it has no inverse\",a1,lname\n end if;\nend if;\n#######################################\n###Checking if a1 is almost idempotent\n####################################### \npp :=cmul[lname](p,p):\nif match(pp=aaa*p,cliterms(p),'s') then \n if f lagBdiag then \n error \"element 'p'=%1 is almost an idempotent sinc e %2 and as such it has no inverse in signature %3\", a1,subs(s,'cmul' ('p','p')=aaa*'p'),Bsignature(lname)\n else \n error \"element 'p' =%1 is almost an idempotent since %2 and as such it has no inverse in \+ current %3\", a1,subs(s,'cmul'('p','p')=aaa*'p'),lname\n end if;\nen d if;\n#######################################\nS:=\{solve(pp-s*p,s)\} :\nif not evalb(S=\{\}) then \n if flagBdiag then \n error \"eleme nt 'p'=%1 is almost an idempotent since %2 and as such it has no inver se in signature %3\", a1,subs(aaa=op(S),'cmul'('p','p')=aaa*'p'),Bsign ature(lname)\n else \n error \"element 'p'=%1 is almost an idempot ent since %2 and as such it has no inverse in current\", a1,subs(aaa=o p(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 pseudodeterminant of a 2 x 2 matrix with entries in a Clifford algebra Cl(B)." }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 68 "Typical use: M : = linalg[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 532 "pseudodet:=pr oc(a1::\{climatrix,matrix\}) local M,a,b,c,d;\noptions `Copyright (c) \+ 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: November 5, 2002`;\n################# ############################\nM:=map(displayid,evalm(a1)):\nif linalg[ rowdim](M) <> 2 or linalg[coldim](M) <> 2 then \n error \"matrix mus t be 2 x 2\" \nend if;\na:=simplify(M[1,1]): b:=simplify(M[1,2]):\nc: =simplify(M[2,1]): d:=simplify(M[2,2]):\nreturn simplify(cmul(a,rever sion(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 ele ments in Cl(3) (or the para-bivectors in Cl(3)). Thus, a quaternion ba sis is [Id, e3we2,e1we3,e2we1] and it is available as the first compon ent of global variable '_quatbasis' defined at the initialization time (type _quatbasis or _quatbasis[1] at the Maple prompt to see it). Se e P. Lounesto, \"Clifford Algebras and Spinors\", page 49, for more in formation on quaternions. Any element that belongs to this vector spa ce is now of type 'quaternion'. The infix form of this multiplication \+ is `&q`. Via the procedure 'rmulm', the quaternionic multiplication \+ 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 terms of t he basis \{Id, qi, qj, qk\}, apply 'qdisplay' to the result of 'qmul'. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 105 " Typical use: qmul(Id + e1we2, e1we3); or (Id + 2*e1we2) &q (e2we3 + e 1we2); or (Id + qi) &q (qj + qk); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1298 "qmul:=proc() local q1,q2,q3,step1,repqmul; \n \+ global B,qi,qj,qk,_default_Clifford_product;\noptions `Copyright ( c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: November 5, 2002`;\n############## ###############################\nif member(0,[args]) then return 0 end if;\nif nargs=1 then return qdisplay(args) end if;\n repqmul:=proc( ) \n if nargs=1 then return args elif\n nargs=2 then return 'qmul'(args) else\n return repqmul(args[1..(nargs-2)],'qmul'(a rgs[nargs-1],args[nargs])) \n end if;\n end proc:\nif nargs>2 th en \n q3:=eval(repqmul(args)):\n return qdisplay(map(combine,q3,tr ig)) \nend if;\n_default_Clifford_product:='cmulNUM':\nq1:=eval(args[1 ]):q2:=eval(args[2]):\nif type(q1,`^`) or type(q2,`^`) then \n error \"illegal expression found: use 'qinv' for the quaternionic inverse\" \nend if;\nif type(q1,cliscalar) or type(q2,cliscalar) then \n retu rn 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,quaternio n) or not type(q2,quaternion) then\n error \"wrong input type: input must be of type 'cliscalar' or 'quaternion'\" \nend if;\nstep1:=reord er(cmul(q1,q2));\nreturn qdisplay(map(combine,clicollect(step1),trig)) \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 375 23 "No. 67. Ampersand form \+ " }{TEXT 383 4 "`&q`" }{TEXT 384 4 " of " }{TEXT 385 4 "qmul" }{TEXT 386 39 ".\n(Has been moved to Clifford:-setup).\n" }}{PARA 258 "" 0 " " {TEXT -1 42 "No. 68. Defining quaternionic conjugation " }{TEXT 387 8 "q_conjug" }{TEXT -1 112 ". Recall that complex conjugation was nam ed 'c_conjug' while the Clifford conjugation was just 'conjugation'. \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 68 "T ypical use: q_conjug(Id + 2*e1we2); or q_conjug(Id + 2*qi + qk); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 557 "q_conjug:=proc(q::algebraic) loc al q1; global qi,qj,qk;\noptions `Copyright (c) 1995-2003 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: November 5, 2002`;\n####################################### ######\nif type(q,matrix) then return map(procname,q) elif\n type(q, \{cliscalar,quaternion\}) then\nq1:=eval(q):\nif type(q1,cliscalar) th en return q1 \nelse\n return qdisplay(2*scalarpart(q1)-q1)\nend if; \nelse\n error \"wrong input types: input must be of type 'cliscalar ', 'quaternion', or 'matrix' \" \nend if;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 26 "No. 69. Quaternionic norm " }{TEXT 388 5 "qnorm" } {TEXT -1 24 " is defined as follows: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 65 " Typical use: qnorm(Id + 2*e1we2); or qnorm(Id + qi + qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 446 "qnorm:=proc(q::\{cliscalar,quatern ion\}) local q1,n,co; global qi,qj,qk;\noptions `Copyright (c) 1995-20 03 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nd escription `Last revised: November 5, 2002`;\n######################## #####################\nq1:=expand(eval(q));\nif type(q1,cliscalar) the n return abs(q1) \nelse\n n:=0:for co in [coeffs(q1,cliterms(q1))] d o n:=n+co^2 end do;\n return combine(sqrt(n),trig) \nend if;\nend pr oc:\n" }}{PARA 258 "" 0 "" {TEXT -1 38 "No. 70. Quaternionic inverse i s named " }{TEXT 389 4 "qinv" }{TEXT -1 141 ". Recall that the invers e of a Clifford polynomial can be calculated with 'cinv' and that quat ernions form a noncommutative division ring. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 66 "Typical use: qinv(Id + \+ 2*e1we2); or qinv(Id + 2*qi + 3*qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 456 "qinv:=proc(q::\{cliscala r,quaternion\}) local q1,q2; \noptions `Copyright (c) 1995-2003 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: November 5, 2002`;\n################################# ############\nq1:=eval(q):\nif q1=0 then error \"zero quaternion has n o inverse\"\nelif type(q1,cliscalar) and q1<>0 then return 1/q1\nelse \+ q2:=q_conjug(q1)/(qnorm(q1))^2:\n return qdisplay(map(combine,q2,t rig))\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 71. \+ Procedure " }{TEXT 390 8 "qdisplay" }{TEXT -1 101 " displays quaternio ns or matrices with quaternionic entries in terms of the basis \{Id, q i, qj, qk\}. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 360 93 "Typical use: qdisplay(e1we2 + 2*Id); map(qdisplay, matri x(2, 2, [Id, e1we2, e2we3, e1we3])); " }{TEXT -1 2 " \n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 712 "qdisplay:=proc(a1::\{algebraic,array\}) local q; global qi,qj,qk;\noptions `Copyright (c) 1995-2003 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: November 5, 2002`;\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;\n end if;\nq:=eval(a1):\nif type(q,cliscalar) then return q end if;\nif \+ type(q,quaternion) then\nq:=map(combine,clicollect(reorder(q)),trig); \nreturn coeff(q,Id)-coeff(q,e1we2)*'qk'+coeff(q,e1we3)*'qj'-coeff(q,e 2we3)*'qi'\nelse \nerror \"wrong input type: input must be of type 'cl iscalar', 'quaternion', or 'matrix' \" \nend if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 72. Procedure " }{TEXT 391 5 "rot3d " }{TEXT -1 161 " rotates a vector in 3-dimensional Euclidean space V \+ using the quaternion multiplication. Namely, any vector v is transfo rmed 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 quat ernion given in the basis [Id, e1we2, e1we3, e2we3]. The first entry s hould be a vector (or any element of the Clifford algebra) while the s econd element is a quaternion. Type '_quatbasis' to see how quaternio ns are defined here. Elements 'qi', 'qj', 'qk' are defined at the tim e 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 i dentify matrix as in:\n" }}{PARA 258 "" 0 "" {TEXT -1 28 " >B := linal g[diag](1$3); \n" }}{PARA 258 "" 0 "" {TEXT -1 108 "before using 'rot 3d'. Of course, 'rot3d' will also work if the first argument were any element in Cl(3). \n" }}{PARA 258 "" 0 "" {TEXT -1 296 "NOTE: tradit ionally one uses \{1, i, j, k\} to denote a quaternion basis. Here, w e are using symbol 'qi' for 'i', 'qj' for 'j', and 'qk' for 'k'. Symb ol 'Id' denotes, as usual, the unit element in all Clifford algebras a s well as the unit element in reals, complexes, quaternions, and octon ions. " }}{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 856 "ro t3d:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ a2::quaternion) \nlocal q2,q2inv; global B,qi,qj,qk; \noptions `Copyri ght (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\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 li nalg[equal](B,linalg[diag](1$3)) then \n error \"the identity 3 x 3 \+ matrix must be assigned to B\" \nend if;\nif nargs <> 2 then \n erro r \"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 4894 "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-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5 , 2002`;\n#############################################\nif not member (nargs,\{1,2\}) then\n error \"one or two arguments needed of type 'cl iscalar', 'clibasmon', 'climon', 'clipolynom', and 'symbol'\"\nend if; \nif nargs=2 and not member(s,\{'all','any'\}) then\n error \"second (optional) argument must be 'all' or 'any'\"\nend if;\nif not type(B, diagmatrix) 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 fr om 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 ha s 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):\np 1:=factor(reorder(displayid(p))):\nflagtB:=evalb(type(p1,\{clibasmon,c limon\}) and flagB):\nif flagtB then \n S:=op(Clifford:-extract(p 1,'integers'));\n if nargs=1 then return true else \n v:=[e| |S];\n if not remove(hastype,p1,clibasmon)=NULL\n then v [1]:=remove(hastype,p1,clibasmon)*v[1] \n end if;\n return [ true,v] \n end if; \nend if;\n################################# ########################\n#If p does not belong to any of the special \+ cases above,\n#find common indices to all monomial terms in p, if any, \n#and then simplify p by factoring out the common factors:\n######### ################################################\nT:=cliterms(p):\nco: =`intersect`(op(map(convert,map(Clifford:-extract,T,'integers'),set))) ;\nx:='x':\nif nops(co)<>0 then\n co:=sort(convert(co,list));\n vv :=[seq(cat(e,x),x=co)];\n cf:=cmul(op(vv));\n pnew:=cmul(p,cf,cf,c f);\n if nargs=1 then M:=procname(pnew) \n elif\n nargs=2 \+ then L:=procname(pnew,s);\n M:=[L[1],[op(L[2]),op(vv )]]; \n end if;\n return M\nend if; \n########################### ##########################\n#This is the most general case when no com mon indices\n#in monomial terms are found:\n########################## ###########################\nS2:=map(Clifford:-extract,cliterms(p),'in tegers');\nS:=\{op(map(op,S2))\}; \nv:=table([]):\nfor j from 1 to max g do\nv[j]:=0:\nfor i in S do v[j]:=v[j]+cat(x,j,i)*cat(e,i) \nend do; \nend do;\nv1v2:=cmul(seq(v[j],j=1..maxg));\nexpr:=clicollect(simplify (reorder(p-v1v2))):\nt:=cliterms(expr);sys:=\{\}:\nfor i from 1 to nop s(t) do sys:=\{op(sys),coeff(expr,op(i,t))=0\} end do:\nvars:=sort([op (indets(sys))],lexorder); \n_MaxSols:=1: #setting maximum number of \+ solutions to one\nvars:=convert(vars,set):\nsol:=[solve(sys,vars)]:\ni f nops(sol)=0 then return false end if;\nventries:=[seq(v[j],j=1..maxg )];\n#######################################################\n#Finally , we need to return result in appropriate form.\n#By now, if p were no t factorable, '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)] end if; \n#########################################################\n #If the second parameter is 'any', assign random values\n#to the param eters showing up in the answer. These random\n#values will change with each execution of the program:\n##################################### ####################\nif nargs=2 and s='any' then \nparam:=proc(a1::\{ `=`\}) \n if lhs(a1)=rhs(a1) or rhs(a1)=0 then true else false end i f;\nend proc:\nflagsol:=false:\nfor i from 1 to 2 while not flagsol do \nS2:=\{\}:P1:=\{\}:P2:=\{\}:\nS2:=\{op(sol[1])\};\nparvalues:=[1,-1,1 /2,-1/2,1/3,-1/3];\ndie := rand(1..6):\nfor eq in select(param,S2) do \+ \n if rhs(eq)=0 then P1:=P1 union \{eq\}\n else P1:=P1 \+ union \{lhs(eq)=parvalues[die()]\};\n end if;\nend do;\nP2:=remove(pa ram,S2):\nL:=map(op,subs(P2,ventries));\nif not member(0,subs(P1,map(d enom,L))) then flagsol:=true end if;\nend do:\nif flagsol then return \+ [true,subs(P1,subs(P2,ventries))]\n else return [true,subs(s ol[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 \+ counter-examples\", in eds. R. Ablamowicz, P. Lounesto, and J. Parra, `Clifford algebras with symbolic and numeric computations`, Birkhause r, Boston, 1996, page 19." }}{PARA 258 "" 0 "" {TEXT -1 349 "\nVahlen \+ matrix V is a 2 x 2 matrix with entries in a Clifford algebra Cl(p, q) such that if \n\n V := matrix(2, 2, [a, b, c, d]); \+ \+ \nand a,b,c,d are \+ elements in Cl(p, q), then the following conditions must be met:" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "1. a, b, c, d are products of vectors;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" } }{PARA 258 "" 0 "" {TEXT -1 74 "2. the pseudodeterminant of V is +1 o r -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 1212 "isVahlenmatrix:=proc(cm::\{matrix,climatrix\}) \nlocal expr1 ,expr2,a,b,c,d,m; global B;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: November 5, 2002`;\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[cold im](cm)<>2 then \n error \"to calculate pseudodeterminant matrix mus t be 2 x 2\" \nend if;\nm:=displayid(cm):\na:=simplify(m[1,1]):b:=simp lify(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 fa lse 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; \nif d<>0 then if not isproduct(d) then return false fi end if;\n##### #####################################\n### Condition 2:\n############# #############################\nif not member(pseudodet(m),\{1,-1,Id,-I d\}) 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(expr 1-expr2)=0) then return false end if;\nexpr1:=simplify(cmul(reversion( b),d));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(simplify( expr1-expr2)=0) then return false end if;\nexpr1:=simplify(cmul(d,reve rsion(c)));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(simpl ify(expr1-expr2)=0) then return false end if;\nexpr1:=simplify(cmul(re version(c),a));\nexpr2:=simplify(vectorpart(expr1,1));\nif not evalb(s implify(expr1-expr2)=0) then return false end if;\nreturn true\nend pr oc:" }}{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 1406 "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-2003 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: November 5, 20 02`;\n#############################################\nif type(op(procna me),procedure) then\n lname:=`B`;\n else\n lname:=op(procname); \nend if;\ndp:=displayid(p):\nif maxgrade(dp)=0 then L:=[Id] else L:=[ Id,dp] end if;\nflag:=false:k:='k':a:='a':\nwhile not flag do\npp:=cmu l[lname](L[nops(L)],dp):\nexpr:=expand(add(a[k]*L[k],k=1..nops(L)));\n eq:=clicollect(pp-expr);\nsys:=\{coeffs(eq,cliterms(eq))\};\nvars:=\{s eq(a[k],k=1..nops(L))\};\nsol:=solve(sys,vars):\nif sol<>NULL then fla g:=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 t hen return poly\nelif nargs=2 then\n if args[2]='powers' then retu rn [poly,L]\n elif args[2]='horner' then return convert(poly,hor ner)\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','horne r'\}) then\n return ([convert(poly,horner),L])\n else error \"wrong arguments\"\n end if;\nelse error \"wrong number of arguments: one, two, or three arguments are needed only\"\nend if;\ne nd proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 76. Procedure " } {TEXT 395 15 "subs_climinpoly" }{TEXT -1 283 " substitutes any Cliffor d polynomial p into any polynomial pol in one variable. It may be used with an optional third argument in which case it returns unevaluated \+ polynomial pol in 'horner' form. For example, one can use this procedu re 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_cl iminpoly(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 1332 "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-2003 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n#############################################\nph:=convert (minpoly,horner);\nvar:=op(remove(type,indets(ph),indexed));\nif not t ype(eval(clinumber),\{clibasmon,climon,clipolynom\}) \n then return \+ subs(var=clinumber,ph) \nend if;\nif nops(\{var\})<>1 then varx:=op(se lect((member,\{var\},\{x,y,z\}))) else varx:=var end if;\nif nops(\{va rx\})<>1 then \n error \"expecting only one of x, y, or z as a varia ble in %1 but found %2\",minpoly,varx \nend if:\nd:=degree(ph,varx);\n h:=ph:\nfor k from 1 to d do\n r[k]:=rem(h,x,x,'s');\n q[k]:=con vert(s,horner);\nh:=q[k];\nend do:\ndclinumber:=displayid(clinumber): \nexpr:=clicollect(r[d]*Id+q[d]*dclinumber);\nfor k from d-1 to 1 by - 1 do\n expr:=r[k]*Id+'cmul'(expr,dclinumber);\nend do:\nif nargs=2 \+ then return simplify(eval(expr))\nelif nargs=3 then \n if args[3]='h orner' then return expr \n else \n error \"third (optional) \+ argument, when used, must be 'horner', but received %1 instead\",args[ 3]\n end if;\nelse error \"wrong number of arguments\"\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 77. Procedure " } {TEXT 396 4 "sexp" }{TEXT -1 427 " finds a power series expansion of a Clifford polynomial p up to and including order n modulo the minimal \+ polynomial of p. It is recommended that this procedure be used when n \+ > d, where d is the degree of the minimal polynomial of p. Otherwise, \+ use 'cexp' or 'cexpQ' instead. The reason is that 'sexp' is faster tha n 'cexp' 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 1525 "sexp:=proc(p::\{numeric,cliscalar,clibasmon,cl imon,clipolynom\},n::nonnegint) \nlocal k,pp,pol,powrs,co,te,nte,lname ,coB,nameB;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: N ovember 5, 2002`;\n#############################################\nif n args=2 then\n coB:=1:\n nameB:=`B`: \n lname:=`B`: \nelif nar gs=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(remov e(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \n error \"wrong type of third argument in sexp. See ?sexp for mor e help.\" \n end if;\nelse\n error \"two or three arguments expect ed in sexp. See ?sexp for more help.\"\nend if;\n##################### ################\nif n=0 then \n if type(p,\{numeric,'cliscalar'\}) \+ then return 1 else return Id fi\nend if;\nk:='k':\nif type(p,\{numeric ,cliscalar\}) then return add(p^k/k!,k=0..n) end if;\nif evalb(vectorp art(p,0)=p) then pp:=scalarpart(p);\n return (add(pp^k/k!,k=0..n)*Id ) \nend if;\npol:=climinpoly[lname](p,'powers');\npowrs:=pol[2]:\n### \+ readlib(powmod);\nk:='k':te:='te':\npol:=collect(add(powmod('x',k,pol[ 1],'x')/k!,k=0..n),'x');\nco:=[coeffs(pol,'x','te')]:\nte:=[te]:\nnte: =nops(te):\nfor k from 1 to nte do \n te[k]:=powrs[degree(te[k],'x' )+1] \nend do;\nreturn clicollect(add(co[k]*te[k],k=1..nte))\nend proc :\n" }}{PARA 0 "" 0 "" {TEXT 358 18 "No. 78. Procedure " }{TEXT 397 8 "all_sigs" }{TEXT 398 383 " gives signatures of all real, real simple, real semi-simple, complex, quaternionic, quaternionic simple, and qua ternionic semi_simple Clifford algebras up to and including the dimens ion specified as the first parameter. Second parameter, when used, mus t be 'real', 'complex', or 'quat', while the third parameter must be ' simple' or 'semisimple'.\n\nUse: all_sigs(9,'real','simple');\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 2806 "all_sigs:=proc(r) \nlocal s1,s2,m i,ma,P,Q,p,q,pq,r_pq,c_pq,q_pq,x,\nsimple_r_pq,simple_q_pq,semisimple_ r_pq,semisimple_q_pq;\noptions `Copyright (c) 1995-2003 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: November 5, 2002`;\n######################################### ####\nif nargs=2 then \n s1:=args[2]:\nelif nargs=3 then \n s1:=ar gs[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\nWARNING(`try first argument as range, e.g., 1..9, second ar gument as 'real', 'complex', or 'quat', and third arguments as 'simple ' or 'semisimple' 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) mo d 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='complex' then return c_pq elif\n s1='quat' then retur n q_pq else\n error \"second input string must be 'real', 'comple x' 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(semisimp le_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 re turn simple_r_pq elif\n s2='semisimple' then return semisimple _r_pq else\n error \"third argument must be 'simple' or 'semis imple' but received %1\",args[3]\n fi\nend if;\n################# #################\nif s1='complex' then\n if s2='simple' then return c_pq elif\n s2='semisimple' then return [] \n end if:\nend if; \n##################################\nif s1='quat' then\n simple_ q_pq:=[]:semisimple_q_pq:=[]:\n for x in q_pq do \n if m ember(x[1]-x[2] mod 8,\{5\}) then \n semisimple_q_pq:=[op( semisimple_q_pq),x] \n else \n simple_q_pq:=[op(s imple_q_pq),x]\n end if;\n end do:\n if s2='simple' then return simple_q_pq elif\n s2='semisimple' then return se misimple_q_pq else\n error \"third argument must be 'simple' o r 'semisimple' but received %1 instead\",args[3]\n end if:\nend i f;\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 "adfmatrix" }{TEXT 400 116 " accomplishes addition of two \+ matrices of type 'dfmatrix', that is, matrices whose entries belong to a double field\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 369 "adfmatrix:=pr oc(M1::dfmatrix, M2::dfmatrix) local L1, L2;\noptions `Copyright (c) 1 995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: November 5, 2002`;\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 'double'] are now part of \"CLIFFORD\". They give two sca lar 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_mi nus(psi,phi,f),'s'); where psi and phi are spinors, f is an idempotent , and 's' is an optional argument that will store 'purescalar'.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 2004 "beta_plus:= proc(psi,phi,f) \nloc al locf,locdata,y,m,flag,mons,uu,eq,lambda,sys,sol,Kbas,v,i,vars,flagf ;\nglobal B,_prolevel;\noptions `Copyright (c) 1995-2003 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n######################################## #####\nif not _prolevel then\n if not type(psi,\{cliscalar,clibasmon,c limon,clipolynom\}) then \n error \"first argument must be of type 'c liscalar', 'clibasmon', 'climon', or 'clipolynom'\" \n end if;\n if no t type(phi,\{cliscalar,clibasmon,climon,clipolynom\}) then \n error \+ \"second argument must be of type 'cliscalar', 'clibasmon', 'climon', \+ or 'clipolynom'\" \n end if;\nend if;\n###Load in pre-computed data an d check if idempotents are the same\nlocdata:=clidata(B):\nlocf:=eval( locdata[4]);\nKbas:=locdata[6];\nif nops(Kbas)>1 then\n flagf:=evalb (f=eval(locf) or f=gradeinv(locf) or \n f=-gradeinv(loc f) or f=-eval(locf));\n if not flagf then\nerror \"when K = C or K = H, primitive idempotent f = plus/minus clidata(B)[4] or its grade inv olution\"\n end if;\nend if;\n###\n y:=cmul(reversion(expand(psi) ),expand(phi));\n if y = 0 then return 0 end if;\n m := 'm';i:=' i':\n flag := false;\n mons := cbasis(linalg[coldim](B));\n v := array(1 .. nops(Kbas),[]);\n lambda := add(v[i]*Kbas[i],i=1..no ps(Kbas));\n for m in mons while not flag do\n uu := m;\n \+ eq := clicollect(cmul(m,y) - expand(cmul(lambda,f)));\n sy s := \{coeffs(eq, cliterms(eq))\};\n vars := \{seq(v[i], i = 1 \+ .. nops(Kbas))\};\n sol := solve(sys, vars);\n flag := n ot evalb(sol = NULL)\n end do:\n if nargs = 4 then\n if no t type(args[4],name) or type(args[4],protected) then \n error \"fourth optional argument, when used, must be of type unprotected na me\"\n else assign(args[4],uu) \n end if;\n end if;\n \+ lambda:=subs(sol,lambda):\n if vectorpart(lambda,0)=lambda then r eturn (scalarpart(lambda)) \n else return lambda\n end if;\ne nd proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2036 "beta_minus:= proc(p si,phi,f) \nlocal locf,locdata,y,m,flag,mons,uu,eq,lambda,sys,sol,Kbas ,v,i,vars,flagf;\nglobal B,_prolevel;\noptions `Copyright (c) 1995-200 3 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: November 5, 2002`;\n######################### ####################\nif not _prolevel then\n if not type(psi,\{clisca lar,clibasmon,climon,clipolynom\}) then \n error \"first argument mus t be of type 'cliscalar', 'clibasmon', 'climon', or 'clipolynom'\" \n \+ end if;\n if not type(phi,\{cliscalar,clibasmon,climon,clipolynom\}) t hen \n error \"second argument must be of type 'cliscalar', 'clibasmon ', 'climon', or 'clipolynom'\" \n end if;\nend if;\n###Load in pre-com puted data and check if idempotents are the same\nlocdata := clidata(B ):\nlocf := eval(locdata[4]);\nKbas := locdata[6];\nif nops(Kbas)>1 th en\n flagf:=evalb(f=eval(locf) or f=gradeinv(locf) or \n \+ f=-gradeinv(locf) or f=-eval(locf));\n if not flagf then\n \+ error \"when K = C or K = H, primitive idempotent f = plus/minus clida ta(B)[4] or its grade involution\"\n end if;\nend if;\n###\n y := cmul(conjugation(expand(psi)),expand(phi));\n if y = 0 then return 0 end if;\n m := 'm';i:='i':\n flag := false;\n mons := cbas is(linalg[coldim](B));\n v := array(1 .. nops(Kbas),[]);\n lambd a := add(v[i]*Kbas[i],i=1..nops(Kbas));\n for m in mons while not f lag 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(s ys, 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],prot ected) then \n error \"fourth optional argument, when used, m ust be of type unprotected name\"\n else assign(args[4],uu) \n end if;\n end if;\n lambda:=subs(sol,lambda):\n if \+ vectorpart(lambda,0)=lambda then \n return scalarpart(lambda) \n else \n return lambda\n end if;\nend proc:\n" }}{PARA 0 " " 0 "" {TEXT 362 18 "No. 82. Procedure " }{TEXT 405 9 "cdfmatrix" } {TEXT 406 100 " creates a matrix over double field from a list of two \+ matrices or from a serquence of to matrices.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 921 "cdfmatrix:=proc() local l1,l2,L,i,j,m,n,m1,m2,MN;\no ptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: November 5, 200 2`;\n#############################################\nif nargs=1 and typ e(args[1],list(\{matrix,array\})) \n then m1,m2:= evalm( args[1][1]),evalm(args[1][2]);\nelif nargs=2 and type(args[1],\{matrix ,array\}) and type(args[2],\{matrix,array\}) \n then m1, m2:= evalm(args[1]),evalm(args[2])\nelse error \"wrong number or types of arguments. See ?cdfmatrix for help.\" \nend if;\n l1:=convert(m 1,mlist);\n l2:=convert(m2,mlist);\n L:=[];\n for i to nops(l 1) do \n L:=[op(L),[l1[i],l2[i]]] \n end do:\n m:=linal g[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 "ddfmat rix" }{TEXT 408 64 " decomposes a matrix over double field into a pair of matrices.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 460 "ddfmatrix:=proc (M::dfmatrix) local m,n,i,L1,L2,L;\noptions `Copyright (c) 1995-2003 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescr iption `Last revised: November 5, 2002`;\n############################ #################\n m:=linalg[rowdim](M);\n n:=linalg[coldim](M) ;\n L:=convert(M,mlist);\n L1:=[seq(L[i][1],i=1..nops(L))];\n \+ L2:=[seq(L[i][2],i=1..nops(L))];\n return [linalg[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 symmetric matrix.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 784 "diagonalize:=proc(m::symmatrix) local locB,flag,i ,j,L,v,S,Bdiag;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: November 5, 2002`;\n#############################################\n if linalg[coldim](m)<>linalg[rowdim](m) then\n error \"expected a sq uare matrix as input\" \nend if;\nif type(m,diagmatrix) then \n retu rn evalm(m) \nend if; \nL:=[linalg[eigenvects](m)];\nflag:=true:\nfor \+ i from 1 to nops(L) while flag=true do\n if L[i][2]>nops(L[i][3]) t hen flag:=false end if: \nend do: \nif not flag then \n error \"sinc e matrix entered does not have a complete set of linearly independent \+ eigenvectors, it is not diagonalizable\" \nend if;\nreturn linalg[diag ](seq(seq(L[i][1],j=1..L[i][2]),i=1..nops(L)))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 365 6 "No. 85" }{TEXT -1 1 "." }{TEXT 366 11 " Procedu re " }{TEXT 411 9 "mdfmatrix" }{TEXT 412 46 " multiplies two matrices \+ over a double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 365 "mdfmatri x:=proc(M1::dfmatrix,M2::dfmatrix) local L1, L2;\noptions `Copyright ( c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: November 5, 2002`;\n############## ###############################\n L1:=ddfmatrix(M1);\n L2:=ddfma trix(M2);\n return cdfmatrix((L1[1]) &cm (L2[1]),(L1[2]) &cm (L2[2] ))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 370 18 "No. 86. Procedure " } {TEXT 413 7 "cocycle" }{TEXT 414 901 " finds an element x in the given Clifford algebra such that cmul(x,a1) = cmul(a2,x) where a1 and a2 ar e the first two arguments of type 'clibasmon', 'climon', or 'clipolyno m'. \n\nIf only two arguments are passed to the procedure, element x b elongs to the Clifford algebra over the lowest dimension dim = max(max index(a1),maxindex(a2)). \n\nIf three arguments are used with the thi rd argument being a list of elements of type 'clibasmon', 'climon', or 'clipolynom', then x belongs to the set generated by a1, a2, and the \+ elements in the third list a3. \n\nIf the fourth argument a4 is used, \+ then the third argument is expected to be a list of elements of type ' clibasmon', in which case the procedure searches for x from that list. \n\nTypical use:\n\ncocycle(1+2*e1-e1we3,3*e2+e2we4);\ncocycle(1+2*e1- e1we3,3*e2+e2we4, [e1we2+Id,e1we2we3,e4]);\ncocycle(1+2*e1-e1we3,3*e2+ e2we4, [e1we2,e1we2we3,e4],'clibasmon');\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1471 "cocycle:=proc(a1::\{clibasmon,climon,clipolynom\}, \n a2::\{clibasmon,climon,clipolynom\},\n a3 ::list(\{clibasmon,climon,clipolynom\}),\n a4::symbol) \n local g,v,n,llist,i,d,S,x,y,xy,sys,vars,sol,llist1,llist2,llist3;\nopt ions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser . All rights reserved.`;\ndescription `Last revised: November 5, 2002` ;\n#############################################\n#if a1=a2 then retur n [Id] end if;\nif nargs=4 and member(args[4],\{clibasmon,clibasmon\}) then\n llist:=a3:\n S:=[]:\n for i from 1 to nops(llist) do\n x :=cmul(llist[i],a1): y:=cmul(a2,llist[i]):\n if x-y =0 then\n \+ if x <> 0 and y <> 0 then\n if cmul(llist[i],llist[i]) <> 0 the n\n S:=[op(S),llist[i] ]:\n end if: \n end if: \n end if:\n end do:\nreturn S\nend if;\nif nargs=3 then\n llist1:= `union`(op(map(cliterms,remove(member,\{seq(op(\{cmul(a1,g),cmul(g,a1) \}),g=a3)\},\{0\})))):\n llist2:=`union`(op(map(cliterms,remove(membe r,\{seq(op(\{cmul(a2,g),cmul(g,a2)\}),g=a3)\},\{0\})))):\n llist3:=ma p(op@cliterms,convert(a3,set)); \n llist:=convert(`union`(llist1,lli st2,llist3),list):\n llist:=sort([op(llist),op(cliterms(op(a3)))],byg rade):\nelse\n llist:=cbasis(max(maxindex(a1),maxindex(a2))):\nend if ;\nn:=nops(llist):\ng:=add(_X[i]*llist[i],i=1..n);\nvars:=\{seq(_X[i], i=1..n)\}:\nxy:=clicollect(cmul(g,a1)-cmul(a2,g)):\nsys:=\{coeffs(xy,l list)\};\nsys:=map(normal,sys);\nsol:=solve(sys,vars);\nreturn subs(so l,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 592 "clisolve:=proc(eq:: \{clibasmon,climon,clipolynom\},indet::\{list,algebraic\}) \nlocal i,T ,vars,sol,sys;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz a nd Bertfried Fauser. All rights reserved.`;\ndescription `Last revised : November 5, 2002`;\n#############################################\ni f type(indet,list) then\n vars:=convert(indet,set)\nelse\n vars:=sel ect(type,indets(indet),indexed)\nend if;\nT:=cliterms(eq);\nsys:=\{coe ffs(clicollect(simplify(eq)),T)\};\nsol:=[solve(sys,vars)];\nif type(i ndet,list) then\n return sol\nelse\n return [seq(subs(sol[i],indet), i=1..nops(sol))]\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 88. This procedure " }{TEXT 372 13 "CLIFFORD_ENV " }{TEXT 417 135 " lists all environnmental variables defined in Clifford, Cliplus, GTP, Octonion, and Bigebra packages, when these packages are loaded. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6578 "CLIFFORD_ENV:=proc() global _warnings_flag:\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revis ed: November 5, 2002`;\n############################################# \nif not assigned(Clifford) then \n lprint(`>>> Package Clifford has not been loaded yet. Type 'with(Clifford)' at the Maple prompt to loa d it first. <<<`)\nelse\n print('``');###Print blank line\n lprint(`>> > Global variables defined in Clifford:-setup are now available and ha ve these values: <<<`);\nlprint(`************* Start *************`); \+ \n########################\nlprint('dim_V'=dim_V);\n #(dimension o f the carrier space for Cl(V,B))\nif not member(dim_V,\{1,2,3,4,5,6,7, 8,9\}) and _warnings_flag then\n lprint(`Warning, value of dim_V is \+ expected to be a positive integer between 1 and 9, inclusive.`);\n p rint('``');###Print blank line\nend if;\n########################\nlpr int('_default_Clifford_product'=_default_Clifford_product);\n #(c ontrols whether cmulRS or cmulNUM is used in Clifford product 'cmul') \n#lprint(`Possible values are: 'cmulRS','cmulNUM','cmulgen','cmul_use r_defined'.`);\nif not member(_default_Clifford_product,\{'cmulRS','cm ulNUM','cmulgen','cmul_user_defined'\}) \n and _warnings_flag then\n lprint(`****** SERIOUS WARNING ******`); \n lprint(`>>> Value of \+ _default_Clifford_product was expected to be 'cmulRS', 'cmulNUM', 'cmu lgen', or 'cmul_user_defined'. <<<`);\n lprint(`******************** *********`);\nend if;\n########################\nlprint('_prolevel'=_p rolevel);\n #(controls whether or not parsing is done)\nif not me mber(_prolevel,\{true,false\}) and _warnings_flag then\n lprint(`War ning, value of _prolevel is expected to be true or false.`);\n print ('``');###Print blank line\nend if;\n########################\nlprint( '_shortcut_in_minimalideal'=_shortcut_in_minimalideal);\n #(contr ols flow in procedure 'minimalideal')\nif not member(_shortcut_in_mini malideal,\{true,false\}) and _warnings_flag then\n lprint(`Warning, \+ value of _shortcut_in_minimalideal is expected to be true or false.`); \n print('``');###Print blank line\nend if;\n####################### #\nlprint('_shortcut_in_Kfield'=_shortcut_in_Kfield);\n #(control s flow in procedure 'Kfield')\nif not member(_shortcut_in_Kfield,\{tru e,false\}) and _warnings_flag then\n lprint(`Warning, value of _shor tcut_in_Kfield is expected to be true or false.`);\n print('``');### Print blank line\nend if;\n########################\nlprint('_shortcut _in_spinorKbasis'=_shortcut_in_spinorKbasis);\n #(controls flow i n procedure 'spinorKbasis')\nif not member(_shortcut_in_spinorKbasis, \{true,false\}) and _warnings_flag then\n lprint(`Warning, value of \+ _shortcut_in_spinorKbasis is expected to be true or false.`);\n prin t('``');###Print blank line\nend if;\n########################\nlprint ('_shortcut_in_spinorKrepr'=_shortcut_in_spinorKrepr);\n #(contro ls flow in procedure 'spinorKrepr')\nif not member(_shortcut_in_spinor Krepr,\{true,false\}) and _warnings_flag then\n lprint(`Warning, val ue of _shortcut_in_spinorKrepr is expected to be true or false.`);\n \+ print('``');###Print blank line\nend if;\n########################\nl print('_warnings_flag'=_warnings_flag);\n #(controls whether some procedures, e.g., 'wedge', give warnings)\nif not member(_warnings_fl ag,\{true,false\}) then\n lprint(`Warning, value of _warnings_flag i s expected to be true or false.`);\n print('``');###Print blank line \nend if;\n########################\nlprint('_scalartypes'=_scalartype s);\n #(defines types considered to be 'scalars' by 'clibilinear' and 'clilinear')\n########################\nlprint('_quatbasis'=_quat basis);\n #(defines default quaternionic basis')\nlprint(`******* ****** End *************`);\nprint('``');###Print blank line \nend if; \n########################\nif assigned(Cliplus) then\n print('``');## #Print blank line\n lprint(`>>> Global variables defined in Cliplus:-s etup are now available and have these values: <<<`);\n lprint(`****** ******* Start *************`);\n lprint('macro(cmul=climul)');\n \+ #('cmul' is now extended by 'climul') \n lprint('macro(cmulQ=climul)') ;\n #('cmulQ' is now extended by 'climul')\n lprint('macro(`&c`=c limul)');\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 'cl irev')\n lprint('macro(LC=LCbig)');\n #('LC' is now extended by ' LCbig')\n lprint('macro(RC=RCbig)');\n #('RC' is now extended by \+ 'RCbig')\n if _warnings_flag then \n lprint(`Warning, new definiti ons for type/climon and type/clipolynom now include &C`);\n end if;\n \+ lprint(`************* End *************`);\n print('``');###Print blan k line \nend if;\n\n################################################## ##\n### Executable Bigebra file for Maple 6 is Bigebra6\n############# #######################################\nif assigned(Bigebra6) then\n \+ print('``');###Print blank line\n lprint(`>>> Global variables defined in Bigebra:-init are now available and have these values: <<<`);\n l print(`************* Start *************`);\n lprint('_CLIENV[_SILENT] '=_CLIENV[_SILENT]); #controls messaging upon starting 'Bigebra'\n lp rint('_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 p rint('``');###Print blank line\n lprint(`>>> Global variables defined \+ in Octonion:-setup are now available and have these values: <<<`);\n \+ print('``');###Print blank line\n lprint(`************* Start ******** *****`); \n lprint('_octbasis'=_octbasis); #standard octonio n basis as Maple global variable\n lprint('_pureoctbasis'=_pureoctbasi s); #pure octonion basis as Maple global variable\n lprint('_default_ Fano_triples'=_default_Fano_triples); #default list of Fano triples\n \+ lprint('_default_squares'=_default_squares); #default squares of e1,e2 ,e3,e4,e5,e6,e7\n lprint('_default_Clifford_product'=_default_Clifford _product); #selects cmulNUM for numeric B\n lprint(`************* End \+ *************`);\n print('``');###Print blank line \nend if;\n######## ##################################\n\nreturn NULL\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 373 18 "No. 89. Procedure " }{TEXT 418 13 "makec libasmon" }{TEXT 419 402 " that takes a list and makes Grassmann basis monomials. It is expected, that the list contains positive integers b etween 1 and 9 inclusive, or symbolic indices consisting of one-charac ter strings. If the list is empty, then Id is returned. If any two ele ments in the list are peated, then 0 is returned. This procedure has a remember table.\n\nTypical use: makeclibasmon([]); makeclibasmon([1,7 ,i,j,3]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 473 "makeclibasmon:=proc (x::list) \nlocal result,N,i;\noptions `Copyright (c) 1995-2003 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`,remember;\nd escription `Last revised: November 5, 2002`;\n######################## #####################\n N:=nops(x);\n if N = 0 then return Id end if ;\n if N > nops(convert(x,set)) then return 0 end if;\n result:=ca t(e,x[1]);\n for i from 2 to N do\n result:=cat(result,cat(we, x[i]));\n end do:\nreturn result\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 90. Procedure " }{TEXT 474 12 "rd_clibasmon" }{TEXT -1 405 " generates a random Grassmann basis monomial. It can be used w ithout any arguments in which case default values are used internally, or with 1 or 2 arguments as follows:\n\nNT1 = maximum allowed index v alue (default 9)\nNT2 = maximum allowed grade (default 4)\n\nrd_clibas mon(); then NT1 = 9, NT2 = 4 \nrd_clibasmon(a1); the n NT1 = a1, NT2 = 4\nrd_clibasmon(a1,a2); then NT1 = a1, NT2 = a2\n \n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1403 "rd_clibasmon:=proc() local ind,NT1,NT2,nt1d,nt2d,L;\noptions `Copyright (c) 1995-2003 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: November 5, 2002`;\n##################################### ########\n### NT1 = maximum allowed index value (default 9)\n### NT2 = maximum allowed grade (default 4) (must be less than or equal to NT1) \nnt1d,nt2d:=9,4:\n#############################################\nif n args=0 then\n NT1,NT2:=nt1d,rand(0..nt2d)(): #defaults\n L:=[[]]: \nelif nargs=1 then\n if not type(args[1],nonnegint) or not evalb(ar gs[1]<=9 and args[1]>= 0) then\n error \"argument must be non neg ative integer between 0 and 9 giving the maximum monomial index\"\n \+ end if;\n NT1,NT2:=args[1],rand(0..args[1])():\n L:=[[]]: \n eli f nargs>=2 then\n if evalb(not type([args],list(nonnegint)) or \n not evalb(args[1]<=9 and args[1]>=0) or\n not evalb(args[2] <=args[1] and args[2]>=0)) then\nerror \"first argument must be non ne gative integer between 0 and 9 giving maximum monomial index. Second a rgument must be non negative integer between 0 and first argument givi ng maximum possible grade. Other arguments, if present, are ignored.\" \n end if;\n NT1,NT2:=args[1],min(args[1],args[2]):\n L:=[]:\n \+ end if:\n##############\nL:=[op(L),op(combinat[choose](NT1,NT2))];\n ind:=sort(L[rand(1..nops(L))()]);\nreturn Clifford:-makeclibasmon(ind) \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 91. Procedure " } {TEXT 475 9 "rd_climon" }{TEXT -1 560 " generates a random Grassmann m onomial. It can be used without any arguments in which case default va lues are used internally, or with 1, 2, or 3 arguments as follows:\n\n NT1 = maximum allowed index value (default 9)\nNT2 = maximum allowed g rade (default 4)\nNT3 = maximum absolute value of coefficients allowed (default 12)\n\nrd_climon(); then NT1 = 9, NT2 = 4, N T3 = 12 \nrd_climon(a1); then NT1 = a1, NT2 = 4, NT3 = 12 \nrd_climon(a1,a2); then NT1 = a1, NT2 = a2, NT3 = 12\nrd_climo n(a1,a2,a3); then NT1 = a1, NT2 = a2, NT3 = a3\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 1992 "rd_climon:=proc() local rcf,NT1,NT2,NT3,nt1d,nt2d ,nt3d;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Novemb er 5, 2002`;\n#############################################\n### NT1 = maximum allowed index value (default 9)\n### NT2 = maximum allowed gr ade (default 4)\n### NT3 = maximum absolute value of coefficient allow ed (default 12)\nnt1d,nt2d,nt3d:=9,4,12:\n############################ #################\nif nargs=0 then\n NT1,NT2,NT3:=nt1d,rand(0..nt2d) (),rand(1..nt3d)(): #defaults\nelif nargs=1 then\n if not type(args[ 1],nonnegint) or not evalb(args[1]<=9 and args[1]>= 0) then\n err or \"argument must be non negative integer between 0 and 9 giving the \+ maximum monomial index\"\n end if;\n NT1,NT2,NT3:=args[1],rand(0.. args[1])(),rand(1..nt3d)(); \nelif nargs=2 then\n if evalb(not type( [args],list(nonnegint)) or \n not evalb(args[1]<=9 and args [1]>=0) or\n not evalb(args[2]<=args[1] and args[2]>=0)) th en\nerror \"first argument must be non negative integer between 0 and \+ 9 giving maximum monomial index. Second argument must be non negative \+ integer between 0 and first argument giving maximum possible grade.\" \n end if;\n NT1,NT2,NT3:=args[1],min(args[1],args[2]),rand(1..nt3 d)():\nelif nargs>=3 then\n if evalb(not type([args],list(nonnegint) ) or \n not evalb(args[1]<=9 and args[1]>=0) or\n \+ not evalb(args[2]<=args[1] and args[2]>=0)) then\nerror \"first argu ment must be non negative integer between 0 and 9 giving maximum monom ial index. Second argument must be non negative integer between 0 and \+ first argument giving maximum possible grade. Third argument must be a positive integer giving max value of coefficient. Other arguments, if present, are ignored.\"\n end if;\n NT1,NT2,NT3:=args[1],min(args [1],args[2]),args[3]:\nend if:\n#############\nrcf:=[rand(-NT3..-1)(), rand(1..NT3)()]:\nrcf:=rcf[rand(1..nops(rcf))()];\nreturn rcf*rd_cliba smon(NT1,NT2)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 92. Pro cedure " }{TEXT 476 13 "rd_clipolynom" }{TEXT -1 761 " generates a ran dom Grassmann polynomial. It can be used without any arguments in whic h case default values are used internally, or with 1, 2, 3, or 4 argum ents as follows:\n\nNT1 = maximum allowed index value (default 9)\nNT2 = maximum allowed grade (default 4)\nNT3 = maximum absolute value of \+ coefficients allowed (default 12)\nNT4 = maximum number of terms allo wed (default 4)\n\nrd_clipolynom(); then NT1 = 9, NT2 = 4, NT3 = 12, NT4 = 4 \nrd_clipolynom(a1); then NT1 = a1, NT2 = 4, NT3 = 12, NT4 = 4\nrd_clipolynom(a1,a2); \+ then NT1 = a1, NT2 = a2, NT3 = 12, NT4 = 4\nrd_clipolynoma1,a2,a3); then NT1 = a1, NT2 = a2, NT3 = a3, NT4 = 4\nrd_clipolynom(a1,a 2,a3,a4); then NT1 = a1, NT2 = a2, NT3 = a3, NT4 = a4\n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 3535 "rd_clipolynom:=proc() \nlocal rnt,rcf,NT1, nt1d,NT2,nt2d,NT3,nt3d,NT4,nt4d,L,newL,i,inde,x,m;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: November 5, 2002`;\n############ #################################\n### NT1 = maximum allowed index val ue (default 9)\n### NT2 = maximum allowed grade (default 4) (must be l eq. than NT1)\n### NT3 = maximum absolute value of coefficient allowed (default 12)\n### NT4 = maximum number of terms allowed (default 5)\n nt1d,nt2d,nt3d,nt4d:=9,4,12,5:\n###################################### ###############\nif nargs=0 then\n NT1,NT2,NT3,NT4:=\n nt1d,rand(0 ..nt2d)(),rand(1..nt3d)(),rand(1..nt4d)(): #defaults\nelif nargs=1 the n\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 betw een 0 and 9 giving the maximum monomial index\"\n end if;\n NT1,NT 2,NT3,NT4:=args[1],rand(0..args[1])(),\n rand(1..nt 3d)(),rand(1..nt4d)():\nelif nargs=2 then\nif evalb(not type([args],li st(nonnegint)) or \n not evalb(args[1]<=9 and args[1]>=0) o r\n not evalb(args[2]<=args[1] and args[2]>=0)) then\nerror \"first argument must be non negative integer between 0 and 9 giving \+ maximum monomial index. Second argument must be non negative integer b etween 0 and first argument giving maximum possible grade.\"\n end i f;\n NT1,NT2,NT3,NT4:=args[1],rand(0..min(args[1],args[2]))(),\n \+ rand(1..nt3d)(),rand(1..nt4d)(): \nelif nargs=3 then \n if evalb(not type([args],list(nonnegint)) or \n not ev alb(args[1]<=9 and args[1]>=0) or\n not evalb(args[2]<=args [1] and args[2]>=0)) then\nerror \"first argument must be non negative integer between 0 and 9 giving maximum monomial index. Second argumen t must be non negative integer between 0 and first argument giving max imum possible grade. Third argument must be a positive integer giving \+ max value of coefficient.\";\n end if;\n NT1,NT2,NT3,NT4:=args[1], rand(0..min(args[1],args[2]))(),\n args[3],rand(1.. nt4d)():\nelif nargs>=4 then\n if evalb(not type([args],list(nonnegi nt)) 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 a rgument NT1 must be non negative integer between 0 and 9 giving maximu m monomial index. Second argument NT2 must be non negative integer bet ween 0 and NT1 (inclusive) giving maximum possible grade. Third argume nt NT3 must be a positive integer giving max value of coefficient. Fou rth argument NT4 must be a positive integer giving maximum number of t erms (it is expected to be no larger that number of combinations NT1 c hoose NT2. Other arguments, if present, are ignored.\"\n end if:\n \+ NT1,NT2,NT3,NT4:=args[1],min(args[1],args[2]),args[3],args[4]:\nend i f:\n#############\n### NT1 = maximum allowed index value (default 9)\n ### NT2 = maximum allowed grade (default 5)\n### NT3 = maximum absolut e 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:=mi n(nops(L),NT4):\nL:=convert(L,list):\nnewL:=[[],[[]]]:\nnewL:=newL[ran d(1..2)()]:\nfor i from 1 to m do\n inde:=rand(1..nops(L))();\n \+ x:=L[inde];\n newL:=[op(newL),x];\n L:=subsop(inde=NULL,L);\nend do;\nL:=map(makeclibasmon,newL);\nrcf:=[rand(-NT3..-1)(),rand(1..NT3) ()]:\nreturn add(rcf[rand(1..nops(rcf))()]*L[i],i=1..nops(L))\nend pro c:\n" }}{PARA 258 "" 0 "" {TEXT -1 33 "No. 93. Initialization procedur e " }{TEXT 420 5 "setup" }{TEXT -1 26 " for the Clifford package." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 94 "This \+ package is loaded automatically into Maple session when command with(C lifford); is given." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1632 "setup:=proc() \nlocal x,y,i,j;\nglobal libname,B ,\n_quatbasis,qi,qj,qk,\n_prolevel,\n_shortcut_in_minimalideal,\n_shor tcut_in_Kfield,\n_shortcut_in_spinorKbasis,\n_shortcut_in_spinorKrepr, \ndim_V,\n_warnings_flag,\n_scalartypes,\n_CLIENV,\n_default_Clifford_ product,\npause,\n###################################\n`convert/dfmatr ix`,`convert/mlist`,`convert/str_to_int`,`type/clibasmon`,\n`type/anti symmatrix`,`type/climatrix`,`type/climon`,`type/clipolynom`,\n`type/cl iprod`,`type/cliscalar`,`type/dfmatrix`,`type/diagmatrix`, `type/evene lement`,`type/fieldelement`,`type/gencomplex`,`type/genquatbasis`,\n`t ype/genquaternion`,`type/idempotent`,`type/nilpotent`,`type/oddelement `,\n`type/primitiveidemp`,`type/purequatbasis`,`type/quaternion`,\n`ty pe/symmatrix`,`type/tensorprod`,\n`&c`,`&cQ`,`&cQm`,`&cm`,`&om`,`&q`,` &qm`,`&rm`,`&w`,`&wm`;\n###################################\noptions ` Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n### ######################################################\n_prolevel:=fal se: #assigning default value\n_shortcut_in_minimalideal :=true: #assigning default value\n_shortcut_in_Kfield:=true: #as signing default value\n_shortcut_in_spinorKbasis:=true: #assigning def ault value\n_shortcut_in_spinorKrepr:=true: #assigning default value \n_warnings_flag:=true: #assigning default value\ndim_V:=9: #default value\n_scalartypes:=\{RootOf,mathfun c,function,numeric,rational,constant,indexed,complex,`^`\}:\n_CLIENV[_ QDEF_PREFACTOR]:=-1:\n_default_Clifford_product:=cmulRS: #default Clif ford product\n" }}{PARA 0 "" 0 "" {TEXT 371 98 "(1) Global variable _s calartypes contains all types declared by the user to be of type 'scal ar'. \n" }}{PARA 258 "" 0 "" {TEXT -1 303 "(2) Standard quaternion bas is as Maple global variable as in P. Lounesto \"Clifford Algebras and \+ Spinors\", page 49. To avoid conflicts with i, j, k, etc. traditional ly used in summations, loops, user could define qi, qj, and qk in plac e 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, qk:=-e1we2`\}];\n " }}{PARA 0 "" 0 "" {TEXT 367 48 "(3) Defining abbreviations for quate rnion basis:" }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 "un protect(qi,qj,qk);\nqi:=-e2we3:\nqj:=e1we3:\nqk:=-e1we2:\n" }}{PARA 0 "" 0 "" {TEXT 368 31 "(4) Defining useful functions:\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 83 "pause:=proc(s::nonnegint) local s1:\ns1:=time( ):\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,clibasmon); type( e1we2,clibasmon);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 913 "`type/cliba smon`:=proc(a)\nlocal a1,i,str,lst,e_set,w_set,ind_lst,N;\noptions `Co pyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: November 5, 2002`;\n##### ########################################\na1:=simplify(eval(a)):\n i f a1 = Id then return true end if:\n if type(a1,\{string,name,symbol \}) then\n str:=convert(a1,string);\n lst:=[seq(str[i],i=1..le ngth(a1))];\n N:=(nops(lst)+1)/3;\n if N=1 then \n e_set :=\{lst[1]\};\n w_set:=\{\"w\"\};\n ind_lst:=[lst[2]];\n \+ else\n e_set:=\{seq(lst[3*i-2],i=1..N)\};\n w_set:=\{se q(lst[3*i],i=1..N-1)\};\n ind_lst:=[seq(lst[3*i-1],i=1..N)];\n \+ end if:\n# print(e_set,w_set,ind_lst,N,lst);\n if (e_set=\{\"e \"\}) and (w_set=\{\"w\"\}) and (N=nops(\{op(ind_lst)\})) then\n \+ return true\n 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. Definition of the type " }{TEXT 437 9 "cliscalar" }{TEXT -1 255 ", i.e., Clifford scalar. A Clifford scalar is essential ly any number, function, constant, or an algebraic expression not cont aining any basis monomials (this means that 2*Id is not of type 'clisc alar').\n\nTypical use: type(e1+e2we3+2*Pi*B[1,2],cliscalar);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 763 "`type/cliscalar`:=proc(a::anything ) local a1,locscalartypes;\nglobal `&C`,_scalartypes; \noptions `Copyr ight (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: November 5, 2002`;\n######## #####################################\na1:=simplify(eval(a)):\nlocscal artypes:=remove(member,_scalartypes,\{`^`\}):\nif type(a1,\{matrix,lis t\}) or hastype(a1,clibasmon) or \n hastype(a1,tensorprod) or has(a1 ,`&C`) then return false \nend if: \nif type(a1,locscalartypes) or ev alb(op(map(type,\{op(a1)\},locscalartypes))=true)\n then return true \nend if:\nif type(a1,`^`) then\n if select(hastype,\{a1\},clibasm on)=\{\} then\n return true else error \"illegal expression in %1 \",a1 \n end if:\nend if:\nreturn cliparse(a1)\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 31 "No. 3. Definition of the type " } {TEXT 438 6 "climon" }{TEXT -1 197 ", i.e., Clifford monomial. A Cliff ord monomial is essentially any basis monomial (of type 'clibasmon') m ultiplied by a Clifford scalar (of type 'cliscalar').\n\nTypical use: \+ type(e1we2+2*e2,climon);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 761 "`typ e/climon`:=proc(x1) local x,S,xx,flag6plus:\noptions `Copyright (c) 19 95-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: November 5, 2002`;\n################### ##########################\nx:=simplify(eval(x1)):\nflag6plus:=assigne d(Cliplus):\nif hastype(x,cliprod) and not flag6plus and _warnings_fla g then \n WARNING(`argument to 'type/climon' contains type 'cliprod' . Load 'Cliplus' to extend functionality of CLIFFORD. Type ?cliprod f or 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 evalb(type(xx,`*`) and nops (select(type,\{op(xx)\},S))=1) then\n true \nelse \n false\nend if: \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 30 "No. 4. Definition of t he type " }{TEXT 439 10 "clipolynom" }{TEXT -1 265 ", i.e., Clifford p olynomial. A Clifford polynomial is a multivariate polynomial in the \+ unknowns of type 'climon' or 'cliprod', i.e., Clifford monomial, with \+ coefficients of the type 'cliscalar', i.e., Clifford scalar.\n\nTypica l use: type(e1+2*Pi*e2we3,clipolynom);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 947 "`type/clipolynom`:=proc(x1) local x,flag6plus:\nopti ons `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`; \n#############################################\nx:=simplify(eval(x1)) :\nif type(eval(x),\{matrix,list,set,cliscalar\}) or \n \+ (not type(eval(x),algebraic)) or \n hastype(eval(x),te nsorprod) then \nreturn false \nend if:\nflag6plus:=assigned(Cliplus) :\nif hastype(x,cliprod) and not flag6plus and _warnings_flag then \n \+ WARNING(`argument to 'type/clipolynom' contains type 'cliprod'. Load 'Cliplus' to extend functionality of CLIFFORD. Type ?cliprod for hel p.`);\nend if:\nif evalb(not flag6plus and type(expand(x),`+`) and has type(x,clibasmon) and not hastype(x,cliprod)) \n then return true \+ \nend if:\nif evalb(flag6plus and type(expand(x),`+`) and hastype(x,\{ clibasmon,cliprod\})) then \n return true \nend if: \nreturn false \+ \nend proc:" }}{PARA 0 "" 0 "" {MPLTEXT 0 21 0 "" }{MPLTEXT 1 0 0 "" } }{PARA 0 "" 0 "" {TEXT 432 24 "No. 5. Converts strings " }{TEXT 440 10 "str_to_int" }{TEXT 441 98 " : `1`, `2`, ..., `0` to appropriate di git.\n\nTypical use: map(convert,extract(e1we2),str_to_int);\n" } {MPLTEXT 0 21 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 629 "`convert/str_ to_int`:=proc(a1::symbol)\noptions `Copyright (c) 1995-2003 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`,remember;\ndescr iption `Last revised: November 5, 2002`;\n############################ #################\nif args[1] = `0` then return 0 elif\n args[1] = ` 1` then return 1 elif\n args[1] = `2` then return 2 elif\n args[1] = `3` then return 3 elif\n args[1] = `4` then return 4 elif\n arg s[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 veri fies whether or not its non-zero argument is a nilpotent element in th e given Clifford algebra Cl(B). It is expected that a matrix of the b ilinear form B has been specified. If the element happens to be an i dempotent, 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 input, 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 of list why the first element in the list is the element to b e checked for nilpotency. \n\nTypical use: type((1/2)*(e1 +e1we3),nil potent); #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 2103 "`type/nilpotent`:=proc(a11) \nlocal a1,i,x,y,xx, k,flagB,S,lname,flagindexed;global B;\noptions `Copyright (c) 1995-200 3 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: November 5, 2002`;\n######################### ####################\n##########################################\n##Th is code allows for passing name of the matrix K as a second element in a list:\n##To test element p for nilpotency w.r.t. matrix K enter [p, K];\n##To test element p for nilpotency w.r.t. B enter p, or, [p,B].\n ##########################################\nif type(a11,\{cliscalar,cl ibasmon,climon,clipolynom\}) then\n a1:=a11:\n lname:=`B`:\n fla gindexed:=false:\n if not type(B,matrix) then error \"matrix must be assigned to B\" \n else flagB:=type(B,diagmatrix) \n \+ end if:\nelif type(a11,list) then\n if nops(a11)<>2 then error \" list must have exactly two elements\"\n elif not type(a11[1],\{cl iscalar,clibasmon,climon,clipolynom\}) or\n not type(a11[2], \{name,symbol,matrix,array,`&*`(numeric,\{name,symbol,matrix,array\}) \})\n then error \"list must contain clipolynom and name\"\n el se\n a1:=a11[1]:\n lname:=a11[2]:\n flagindexed:=true:\n if not type(evalm(lname),matrix) then error \"matrix must be assigned to %1\",lname \n else flagB:=type(evalm(lname),diagmatrix) \n end if: \n end if:\nelse\n error \"unexpected argument type \"\nend if:\n###################################\nx:=displayid(a1):\ni f a1=0 then return true \n elif type(a1,cliscalar) then \n \+ return false \n elif (type(x,clibasmon) and flagB and linalg[de t](evalm(lname))<>0) then \n return false \nend if:\n#### ################################\nxx:=cmul[lname](x,x):\nif evalb(xx=0 ) then return true end if:\nif evalb(simplify(xx-x)=0) or not evalb(so lve(xx=k*x,k)=NULL) then return false end if:\ny:=xx:\nfor i from 1 to 2^maxindex(a1) do\n if y=vectorpart(y,0) or y=x then return fal se end if: \n y:=cmul(x,y);\n if y=0 then return true end if:\n end do:\nerror \"Sorry, but I am unable to determine nilp otency of %1\",a1\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 7 . Definition of type " }{TEXT 443 10 "idempotent" }{TEXT -1 311 ". Th e following procedure verifies whether or not its argument is an idemp otent in the given Clifford algebra Cl(B). It is expected that a matr ix of the bilinear form B has been specified. It can also check elemen t p for being idempotent in Cl(K) if K is entered as a second argument in a list such as [p,K].\n" }}{PARA 0 "" 0 "" {TEXT 431 124 "Typical \+ use: type((1/2)*(1 + e1),idempotent); #this is an idempotent in Cl(3, 0)\ntype(p,idempotent);\ntype([p,K],idempotent);" }}{PARA 0 "" 0 "" {TEXT 435 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1577 "`type/idempotent `:=proc(a11) \nlocal f,ff,lname,a1,flagindexed,flagB; global B;\noptio ns `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: November 5, 2002`; \n#############################################\n##################### #####################\n##This code allows for passing name of the matr ix K as a second element in a list:\n##To test element p for being ide mpotent w.r.t. matrix K enter [p,K];\n##To test element p for being id empotent w.r.t. B enter p, or, [p,B].\n############################### ###########\nif type(a11,\{cliscalar,clibasmon,climon,clipolynom\}) th en\n a1:=a11:\n lname:=`B`:\n flagindexed:=false:\n if not \+ type(B,matrix) then error \"matrix must be assigned to B\" \n \+ else flagB:=type(B,diagmatrix) \n end if:\nelif type(a11,list) then\n if nops(a11)<>2 then error \"list must have exactly two elem ents\"\n elif not type(a11[1],\{cliscalar,clibasmon,climon,clipol ynom\}) or\n not type(a11[2],\{name,symbol,matrix,array,`&*` (numeric,\{name,symbol,matrix,array\})\})\n then error \"list mus t contain clipolynom and name\"\n else\n a1:=a11[1]:\n lname:=a1 1[2]:\n flagindexed:=true:\n if not type(evalm(lname),matrix) t hen error \"matrix must be assigned to %1\",lname \n else f lagB:=type(evalm(lname),diagmatrix) \n end if: \n end if:\nelse \n error \"unexpected argument type\"\nend if:\n#################### ####################\nf:=displayid(a1):\nff:=cmul[lname](f,f):\nif eva lb(ff=0) then return false end if:\nreturn evalb(simplify(ff-f)=0)\nen d proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 8. A new type " } {TEXT 444 9 "climatrix" }{TEXT -1 424 " is a matrix with at least one \+ entry of type 'clipolynom'. Note that anything in Maple that has been \+ defined via the procedure linalg[matrix] is of the standard Maple type 'matrix' including matrices with entries in a Clifford algebra. Since a matrix with numerical entries is not of the type 'climatrix', this \+ procedure allows one to distinguish such matrix from those that do hav e at least one entry in a Clifford algebra." }}{PARA 258 "" 0 "" {TEXT -1 208 "\nMatrices of the type 'matrix' but not 'climatrix' may \+ be multiplied using standard Maple matrix multiplication operator `&*` .\n\nMatrices of the type 'climatrix' must be multiplied using the pro cedure 'rmulm'." }}{PARA 0 "" 0 "" {TEXT 430 104 "\nTypical use: M:=li nalg[matrix](2,2,[e1,e3we4+e3,e4,Id-e1]);\n typ e(M,climatrix);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 355 "`type/climatr ix`:=proc(x)\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: \+ November 5, 2002`;\n#############################################\nif \+ type(x,array) then\n return evalb(select(type,convert(x,set),\{clipol ynom,climon,clibasmon\})<>\{\})\nelse \n return false\nend if:\nend p roc:\n" }}{PARA 0 "" 0 "" {TEXT 429 37 "No. 9. Useful conversion funct ion to " }{TEXT 445 5 "mlist" }{TEXT 446 20 " needed by 'rmulm'.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 368 "`convert/mlist`:=proc(a1::matrix) \+ local i,longlist;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: November 5, 2002`;\n############################################# \nlonglist:=[]:\nfor i from 1 to linalg[rowdim](a1) do\nlonglist:=[op( longlist),op(convert(linalg[row](a1,i),list))] od\nend proc:\n" }} {PARA 0 "" 0 "" {TEXT 428 19 "No. 10. A new type " }{TEXT 447 12 "fiel delement" }{TEXT 448 2 ":\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 547 "`ty pe/fieldelement`:=proc(a1::algebraic) global f; \noptions `Copyright ( c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: November 5, 2002`;\n############## ###############################\nif not assigned(f) then \n error \" primitive idempotent f has not been assigned yet\" \nend if:\nif not t ype(f,primitiveidemp) then \n error \"although f has been assigned, \+ it is not of type/primitiveidemp\"\nend if:\nif member(squaremodf(args [1],f),\{-1,1\}) then return true else return 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 469 "`type/symmatrix`:=proc(a1::\{name,symbol,matr ix,`&*`(algebraic,matrix)\}) \noptions `Copyright (c) 1995-2003 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: November 5, 2002`;\n################################# ############\nif evalb(evalm(a1)=a1) then return false end if:\nif lin alg[coldim](a1)<>linalg[rowdim](a1) then\n error \"B must be assigne d 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 "antisymmatrix" }{TEXT 452 31 " - an anti-symmetri c matrix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 474 "`type/antisymmatrix `:=proc(a1::\{name,symbol,matrix,`&*`(algebraic,matrix)\}) \noptions ` Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n### ##########################################\nif evalb(evalm(a1)=a1) the n return false end if:\nif linalg[coldim](a1)<>linalg[rowdim](a1) then \n error \"B must be assigned square matrix\" \nend if:\nreturn lina lg[equal](a1,-linalg[transpose](a1))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 425 20 "No. 13. A new type: " }{TEXT 453 10 "diagmatrix" }{TEXT 454 25 " - a diagonal matrix.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 482 "`type/diagmatrix`:=proc(a1::anything) local N,i,DD;\noptions `Cop yright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: November 5, 2002`;\n###### #######################################\nif not type(a1,\{matrix,`&*`( algebraic,matrix)\}) then return false end if:\nif not type(a1,symmatr ix) 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))\nen d 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 idempot ent of the type (1/2)*(Id+e[i]), i=1..n, where \{e[i],i=1..n\} is a se t of commuting basis monomials with square equal to 1 mod Id. \nIt ret urns 'true' if n = q - RHnumber(q-p), where 'RHnumber' is the Radon-H urwitz function and [p,q] is signature of the current quadratic form w hich is assumed to have been defined, i.e., the bilinear form B has be en defined as a diagonal matrix, and 'false' if n < q - RHnumber(q-p). \n\nIf the argument is the identity element 'Id' of the algebra Cl(Q), the procedure checks if Cl(Q) is simple or semi-simple, and it return s 'true' or 'false' respectively. It is known that when Cl(Q) is semi -simple, 'Id' can be written as a sum of mutually annihilating idempot ents (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 b ilinear 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,primitiveidemp);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 508 "`type/primitiveidemp`:=proc(f::idempotent) local p,q ,numfact;global B;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: November 5, 2002`;\n############################################ #\nif not type(B,matrix) then \n error \"B must be assigned square m atrix\" \nelse\n p:=Bsignature(B)[1]:q:=Bsignature(B)[2]\nend if:\nn umfact:=q-RHnumber(q-p):\nif scalarpart(f)=1/2^numfact then \n retur n true \nelse \n return false \nend if:\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 13 "No. 15. Type " }{TEXT 456 13 "purequatbasis" } {TEXT -1 109 " is a procedure which checks if the given list of three \+ basis monomials can be a basis for pure quaternions.\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 920 "`type/purequatbasis`:=proc(l1::list(\{clibasm on,climon,clipolynom\})) \nlocal p,q,r;global B;\noptions `Copyright ( c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: November 5, 2002`;\n############## ###############################\nif nops(l1) <> 3 then \n error \"li st must have exactly 3 elements of type 'clibasmon', 'climon', or 'cli polynom' but received a list with %1 elements\",nops(l1)\nend if:\nif \+ not type(B,matrix) then \n error \"square matrix must be assigned to B\"\nend if: \np:=l1[1]:q:=l1[2]:r:=l1[3]:\nif cmul(p,p)<>-Id then re turn false elif\n cmul(q,q)<>-Id then return false elif\n cmul(r,r )<>-Id then return false elif\n not member(cmul(p,q),\{r,-r\}) then \+ return false elif\n cmul(p,q)+cmul(q,p)<>0 then return false elif\n \+ cmul(p,r)+cmul(r,p)<>0 then return false elif\n cmul(q,r)+cmul(r,q )<>0 then return false else\n return true\nend if:\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 20 "No. 16. A new type: " }{TEXT 457 10 "ge ncomplex" }{TEXT -1 413 " - a generalized complex element of Cl(B). A Clifford polynomial p in Cl(B) is of this type if it belongs to a sub alegbra A of Cl(B) isomorphic to complex numbers C. Knowing that the g iven 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 tha t 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 886 "`type/g encomplex`:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local \+ L;global B;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: N ovember 5, 2002`;\n#############################################\nif n ot type(B,matrix) then \n error \"can't check type since B is not as signed a matrix\" \nend if:\nif type(a1,cliscalar) then return false e nd if:\nL:=[op(cliterms(reorder(a1)))];\nif nops(L)>2 then return fals e end if:\nif nops(L)=1 and L=[Id] then return false end if:\nif nops( L)=2 and not member(Id,L) then return false end if:\nL:=remove(member, L,[Id]);\nif maxindex(L)>linalg[coldim](B) then \n error \"can't che ck type since the largest index in %1 is greater than size %2 of curre nt form B\", a1,linalg[coldim](B)\nend if:\nif cmul(L[1],L[1])=-Id the n \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 "g enquaternion" }{TEXT -1 513 " - a generalized quaternionic element of \+ Cl(B). A Clifford polynomial p in Cl(B) is of this type if it belongs to a subalegbra A of Cl(B) isomorphic to a division ring H of quatern ions. 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 proc edure 'cinv'.\n\nNote that elements of grade 0 (eg., 2*Id) and element s of type 'gencomplex' - a generalized complex element of Cl(B), are n ot of this type.\n\nTypical use: type(p,genquaternion);\n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 663 "`type/genquaternion`:=proc(a1::\{cliscalar, clibasmon,climon,clipolynom\}) local L;global B;\noptions `Copyright ( c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: November 5, 2002`;\n############## ###############################\nif not type(B,matrix) then \n error \"square matrix must be assigned to B\" \nend if:\nif type(a1,cliscal ar) then return false end if:\nL:=[op(cliterms(reorder(a1)))];\nif nop s(L)>4 or type(a1,gencomplex) then return false end if:\nL:=remove(mem ber,L,[Id]);\nif nops(L)=1 then return false end if:\nif nops(L)=2 the n L:=[op(L),cmul(L[1],L[2])] end if:\nreturn type(L,purequatbasis)\nen d 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 "oddel ement" }{TEXT -1 242 " in Cl(B). These two type-checking procedures d etermine whether their inputs are even elements, odd elements, or neit her in Cl(B).\n\nTypical use: type(p,evenelement);\n \+ type(p,oddelement);\n\nwhere p is a Clifford polynomial.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 775 "`type/evenelement`:=proc(a1::\{cliscalar ,clibasmon,climon,clipolynom\})\noptions `Copyright (c) 1995-2003 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: November 5, 2002`;\n############################### ##############\nif type(eval(a1),cliscalar) then return true end if:\n return evalb(reorder(displayid(eval(a1)-gradeinv(eval(a1))))=0)\nend p roc:\n\n`type/oddelement`:=proc(a1::\{cliscalar,clibasmon,climon,clipo lynom\})\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Ber tfried Fauser. All rights reserved.`;\ndescription `Last revised: Nove mber 5, 2002`;\n#############################################\nif type (eval(a1),cliscalar) then return false end if:\nreturn evalb(reorder(d isplayid(eval(a1)+gradeinv(eval(a1))))=0)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 424 18 "No. 20. New type: " }{TEXT 461 10 "quaternion" } {TEXT 462 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 896 "`type/quaternio n`:=proc(q::algebraic) local aa1,aa2,S;global B,qi,qj,qk;\noptions `Co pyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: November 5, 2002`;\n##### ########################################\nif not assigned(B) or not ty pe(B,matrix) then \n error \"bilinear form B has not been assigned y et. It must be defined as the identity 3 x 3 matrix.\"\nend if:\nif no t linalg[equal](B,linalg[diag](1$3)) then \n error \"identity 3 x 3 \+ matrix must be assigned to B\" \nend if:\nif not type(eval(q),\{'cliba smon','climon','clipolynom'\}) then \n error \"wrong input type: inp ut must be of type 'clibasmon','climon', or 'clipolynom'\" \nend if:\n aa1:=\{op(cliterms(reorder(expand(eval(q)))))\};\naa2:=\{Id,e1we2,e1we 3,e2we3\};#standard basis to be compared to\nS:=aa1 minus aa2;\nif op( S) = NULL then \n return true else return false \nend if:\nend proc :\n" }}{PARA 0 "" 0 "" {TEXT 423 17 "No. 21. New type " }{TEXT 463 10 "tensorprod" }{TEXT 464 183 " is needed to include new types from the \+ package 'GTP' for 'Graded Tensor Product'. This is an experimental pa ckage for computations with graded tensor products of Clifford algebra s." }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 332 "`type/tenso rprod`:=proc(a1::anything)\noptions `Copyright (c) 1995-2003 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: November 5, 2002`;\n#################################### #########\nif type(a1,function) and op(0,a1)=`&t` then return true els e 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. 2 2. New type: " }{TEXT 465 12 "genquatbasis" }{TEXT 466 187 ". This pro cedure checks if the given list or set of four elements is a basis for generalized quaternionic ring.\n\nUse: type([p1,p2,p3,p4], genquatbas is);type(\{p1,p2,p3,p4\}, genquatbasis);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1475 "`type/genquatbasis`:=proc(L::\{list(\{cliscalar,cli basmon,climon,clipolynom\}),\n set(\{clis calar,clibasmon,climon,clipolynom\})\}) \nlocal f,p,q,k,loc,i;global B ;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`;\n###################################### #######\ndescription `Last revised: November 5, 2002`;\nif nops(L) <> \+ 4 or nops(L)<>nops(convert(L,set)) then \n error \"list or set must \+ have exactly 4 different elements\" \nend if:\nif not type(B,matrix) t hen \n error \"square matrix must be assigned to B first\" \nend if: \nf:=op(select(type,L,idempotent)): #select idempotent in L\nif f=NUL L then \n error \"one element in the list must be an idempotent\" \n end if:\nloc:=remove(member,L,\{f\}); #assign remaining element s of L to loc \np,q,k:=seq(loc[i],i=1..3): #assign elements of loc to p,q,k\n##################################\nif cmul(p,p)<>cmul( -Id,f) then return false elif\n cmul(q,q)<>cmul(-Id,f) then return f alse elif\n cmul(k,k)<>cmul(-Id,f) then return false \nend if:\n#### ############################## \nif (cmul(p,q)=cmul(k,f) and cmul(q, p)=-cmul(k,f) and \n cmul(q,k)=cmul(p,f) and cmul(k,q)=-cmul(p,f) a nd \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)=-cmul(p,f) and cmul(k,q)=cmul(p,f) and \n cmul(k,p)=-cmul(q,f) and cmul(p,k)= cmul(q,f))\nthen return true \nelse\n return false\nend if:\nend pro c:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 23. New type" }{TEXT 421 2 ": " }{TEXT 467 7 "cliprod" }{TEXT 468 117 "\n\nUse: type(e1we2 &C e3, cliprod); type(`&C`(e1,e2),cliprod); type(`&C`[K](e1,e2),cliprod); ty pe(&C(e1,e2),cliprod);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 316 "`type/ cliprod`:=proc(f::\{function,anything\}) local p;\noptions `Copyright \+ (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: November 5, 2002`;\n############# ################################\nevalb(member(op(0,f),\{`&C`\}) or me mber(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 matr ix over double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 968 "`conver t/dfmatrix`:=proc() local l1,l2,L,i,j,m,n,m1,m2,MN;\noptions `Copyrigh t (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: November 5, 2002`;\n########### ##################################\nif nargs=1 and type(args[1],dfmatr ix) \n then return args[1]\nelif nargs=1 and type(args[1 ],list(\{matrix,array\})) \n then m1,m2:=evalm(args[1][1 ]),evalm(args[1][2]);\nelif nargs=2 and type(args[1],\{matrix,array\}) and type(args[2],\{matrix,array\}) \n then m1,m2:=evalm (args[1]),evalm(args[2])\nelse error \"wrong number or types of argume nts\" \nend if:\n l1 := convert(m1,mlist);\n l2 := convert(m2,ml ist);\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(MN) \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 434 18 "No. 25. \+ Procedure " }{TEXT 471 13 "type/dfmatrix" }{TEXT 472 73 " checks if a \+ matrix is of type 'dfmatrix', that is, over a double field.\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 496 "`type/dfmatrix`:=proc(m::anything) local mm;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: No vember 5, 2002`;\n#############################################\nif no t type(m,matrix) and not type(m,list(matrix)) then return false end if :\nif type(m,matrix) then \n return type(convert(m,mlist),\n \+ list(list(\{cliscalar,clibasmon,climon,clipolynom,numeric,symbol,alg ebraic\})))\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 2304 "`&c`:=proc() local NP,ARGS,coB,nameB,lname,decindex ,flagdec;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Be rtfried Fauser. All rights reserved.`;\ndescription `Last revised: Nov ember 5, 2002`;\n#############################################\n###### #################################\n### Works when &c[''K''] or &c[''-K ''] is entered and K is a matrix\n#################################### ###\nflagdec:=true:\nif type(op(procname),procedure) then\n if type( [args],listlist) then\n if type(op(args),array) then\n WA RNING(\"enclose index in double quotes as in &c[''B''] or &c[''-B''] w hen B has been assigned a matrix to avoid the following:\");\n \+ return 'procname(args)';\n end if;\n else coB:=1:\n nameB: =`B`:\n lname:=`B`:\n ARGS:=[args]:\n flagdec:=false :\n end if;\nelse lname:=op(procname);\n ARGS:=[args];\n if \+ type(lname,`&*`(numeric,name)) then\n coB:=op(select(type,\{op (lname)\},numeric));\n nameB:=op(select(type,\{op(lname)\},nam e));\n else\n coB:=1:\n nameB:=lname:\n end i f;\n flagdec:=false:\n end if;\n################################## #####\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif type([args] ,listlist) then\n if type(op(args),function) then\n ARGS:=op(op (args));\n coB:=1:\n nameB:=eval(op(0,op(args)));\n if \+ type(nameB,`&*`(numeric,name)) then\n coB:=op(select(type,\{op (nameB)\},numeric));\n nameB:=op(select(type,\{op(nameB)\},nam e));\n end if;\n elif type(op(args),`&*`(numeric,function)) th en\n nameB:=\{op(op(args))\}:\n coB:=op(select(type,nameB,nu meric));\n nameB:=op(select(type,nameB,function));\n ARGS:=o p(nameB);\n nameB:=op(0,nameB);\n else\n error \"unable to determine index or wrong index, 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 erro r \"cannot determine arguments and/or index from arguments\"\n end if; \nreturn coB,nameB,[ARGS];\nend proc:\n############################### ######\nif flagdec then \n coB,nameB,ARGS:=decindex(args);\n lname :=coB*nameB;\nend if;\nNP:=nops(ARGS);\nif member(0,ARGS) then return \+ 0 end if;\nif NP <=1 then return op(ARGS) end if;\nreturn cmul[eval(ln ame)](op(ARGS)); \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2380 "`&cQ`:=proc() local NP,ARGS,coB,nameB,lname,decindex,flagdec;\noption s `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. A ll rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n #############################################\n####################### ################\n### Works when &cQ[''K''] or &cQ[''-K''] is entered \+ and K is a matrix\n#######################################\nflagdec:=t rue:\nif type(op(procname),procedure) then\n if type([args],listlist ) then\n if type(op(args),array) then\n WARNING(\"enclose index in double quotes as in &cQ[''B''] or &cQ[''-B''] when B has bee n assigned a matrix to avoid the following:\");\n return 'procn ame(args)';\n end if;\n else coB:=1:\n nameB:=`B`:\n \+ lname:=`B`:\n ARGS:=[args]:\n flagdec:=false:\n end if; \nelse lname:=op(procname);\n ARGS:=[args];\n if type(lname,`& *`(numeric,name)) then\n coB:=op(select(type,\{op(lname)\},num eric));\n nameB:=op(select(type,\{op(lname)\},name));\n el se\n coB:=1:\n nameB:=lname:\n end if;\n flag dec:=false:\n end if;\n#######################################\ndecind ex:=proc() local ARGS,coB,nameB;global B;\nif type([args],listlist) th en\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)\},num eric));\n nameB:=op(select(type,\{op(nameB)\},name));\n \+ end if;\n elif type(op(args),`&*`(numeric,function)) then\n nam eB:=\{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 in dex 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 \"can not determine arguments and/or index from arguments\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc:\n#####################################\n if flagdec then \n coB,nameB,ARGS:=decindex(args);\n lname:=coB*na meB;\nend if;\nNP:=nops(ARGS);\nif member(0,ARGS) then return 0 end if ;\nif NP <=1 then return op(ARGS) end if;\nreturn cmul[eval(lname)](op (ARGS));\n#return cmulQ[eval(lname)](op(ARGS)); ###Causes an error in \+ `&cQ` \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1855 "`&cQm`:=pr oc() local ARGS,lname,NP,coB,nameB,decindex;\noptions `Copyright (c) 1 995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: November 5, 2002`;\n################## ###########################\n#######################################\n if type([args],listlist) then\n if type(op(args),array) then\n \+ WARNING(\"enclose index in double quotes as in &cQm[''B''] or &cQm[''- B''] when B has been assigned a matrix to avoid the following:\");\n \+ return ('procname(args)');\n end if;\nend if;\n################# ######################\ndecindex:=proc() local ARGS,coB,nameB;global B ;\nif type([args],listlist) then\n if type(op(args),function) then\n ARGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op(ar gs)));\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),`&*`(nume ric,function)) then\n nameB:=\{op(op(args))\}:\n coB:=op(sel ect(type,nameB,numeric));\n nameB:=op(select(type,nameB,function) );\n ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n \+ error \"unable to determine index or wrong index type for &cQm, try en closing 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 coB:=1:\n nameB:=`B`; #default name \nelse\n error \"cannot d etermine arguments and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\n end proc:\n#####################################\ncoB,nameB,ARGS:=deci ndex(args);\nlname:=coB*nameB:\n NP:=nops(ARGS);\n if member(0,ARGS) then return 0 end if;\n if NP <=1 then \n return op(ARGS)\n eli f NP = 2 then \n return rmulm(eval(ARGS[1]),eval(ARGS[2]),cmulQ,ln ame) \n else\n error \"only two arguments and index are allowed\" \n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2447 "`&cm` :=proc() local NP,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Cop yright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: November 5, 2002`;\n###### #######################################\n############################# ##########\n### Works when &cm[''K''] or &cm[''-K''] is entered and K \+ is a matrix\n#######################################\nflagdec:=true:\n if 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 assi gned a matrix to avoid the following:\");\n return 'procname(a rgs)';\n end if;\n else coB:=1:\n nameB:=`B`:\n l name:=`B`:\n ARGS:=[args]:\n flagdec:=false:\n end if; \nelse lname:=op(procname);\n ARGS:=[args];\n if type(lname,`& *`(numeric,name)) then\n coB:=op(select(type,\{op(lname)\},num eric));\n nameB:=op(select(type,\{op(lname)\},name));\n el se\n coB:=1:\n nameB:=lname:\n end if;\n flag dec:=false:\nend if;\n#######################################\ndecinde x:=proc() local ARGS,coB,nameB;global B;\nif type([args],listlist) the n\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)\},nume ric));\n nameB:=op(select(type,\{op(nameB)\},name));\n e nd if;\n elif type(op(args),`&*`(numeric,function)) then\n name B:=\{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 ind ex or wrong 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 d etermine arguments and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\n end proc:\n#####################################\nif flagdec then \n \+ coB,nameB,ARGS:=decindex(args);\n lname:=coB*nameB;\n end if;\n#ret urn (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 e nd if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 232 "`&q`:=proc( )\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`;\ndescription `Last revised: November 5, 2002`;\n#############################################\nreturn qmul(ar gs) \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 465 "`&qm`:=proc() local NP: \noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: N ovember 5, 2002`;\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(ev al(args[1]),eval(args[2]),qmul) \n else\n error \"only two argume nts are allowed in &qm\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 349 "`&om`:=proc()\noptions `Copyright (c) 1995-2003 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: November 5, 2002`;\n############################### ##############\nif not assigned(Octonion) then\n error \"package 'Oc tonion' must be loaded first\"\nend if;\nreturn subs(Id=1,rmulm(args,O ctonion:-omul))\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1847 "` &rm`:=proc() local ARGS,lname,NP,coB,nameB,decindex;\noptions `Copyrig ht (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: November 5, 2002`;\n########## ###################################\n################################# ######\nif type([args],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;glob al B;\nif type([args],listlist) then\n if type(op(args),function) th en\n ARGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,o p(args)));\n if type(nameB,`&*`(numeric,name)) then\n coB :=op(select(type,\{op(nameB)\},numeric));\n nameB:=op(select(t ype,\{op(nameB)\},name));\n end if;\n elif type(op(args),`&*`( numeric,function)) then\n nameB:=\{op(op(args))\}:\n coB:=op (select(type,nameB,numeric));\n nameB:=op(select(type,nameB,funct ion));\n ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n \+ error \"unable to determine index or wrong index type for &rm, try enclosing name of the index in double quotes as in &rm[''B''] or &rm[ ''-B'']\"\n end if;\nelif\n type([args],list) then\n ARGS:=args; \n coB:=1:\n nameB:=`B`; #default name \nelse\n error \"cannot d etermine arguments and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\n end proc:\n#####################################\ncoB,nameB,ARGS:=deci ndex(args);\nlname:=coB*nameB:\n NP:=nops(ARGS);\n if member(0,ARGS) then return 0 end if;\n if NP <=1 then \n return op(ARGS)\n eli f NP = 2 then \n return rmulm(eval(ARGS[1]),eval(ARGS[2]),`&r`,lna me) \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 wedge(args) end proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 466 "`&wm`:=proc() local NP: \noptions `Copyright (c) 1995-2003 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: November 5, 2002`;\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]),eval(args[2]),wedge) \n else\n er ror \"only two arguments are allowed in &wm\"\n end if;\nend proc:\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 171 "############################## ######################\nend proc: ###<< " 0 "" {MPLTEXT 1 0 8 "libname;" }}{PARA 11 "" 1 "" {XPPMATH 20 "6$Q6C:\\Maple7/Cliffordlib6\"Q.C:\\Maple7/libF $" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 59 "Let's add library files to the main library in libna me[1]:\n" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 449 "march('add',li bname[1],`C:\\\\Maple7/Clifforddata/matrealL.m`,`matrealL.m`);\nmarch( 'add',libname[1],`C:\\\\Maple7/Clifforddata/matrealR.m`,`matrealR.m`); \nmarch('add',libname[1],`C:\\\\Maple7/Clifforddata/matcompL.m`,`matco mpL.m`);\nmarch('add',libname[1],`C:\\\\Maple7/Clifforddata/matcompR.m `,`matcompR.m`);\nmarch('add',libname[1],`C:\\\\Maple7/Clifforddata/ma tquatL.m`,`matquatL.m`);\nmarch('add',libname[1],`C:\\\\Maple7/Cliffor ddata/matquatR.m`,`matquatR.m`);" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warni ng, 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 "Wa rning, member \"matcompR.m\" already in archive, skipping\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matquatL.m\" already in archi ve, skipping\n" }}{PARA 7 "" 1 "" {TEXT -1 58 "Warning, member \"matqu atR.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 12 "" 1 "" {XPPMATH 20 "657#7$\"\"%\"\"#7#7$F&F&7#7$F&\"\"\"7#7$F+\"\" (7#7$\"\")\"\"!7#7$\"\"$F57#7$F+F+7#7$F&F27#7$F+F17#7$F%F57#7$\"\"&F57 #7$F2\"\"'7#7$F2F17#7$\"\"*F27#7$F@F%7#7$F2F.7#7$F%F%7#7$F5F+7#7$F5F& " }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matrealR);" }} {PARA 12 "" 1 "" {XPPMATH 20 "657#7$\"\"%\"\"#7#7$F&F&7#7$F&\"\"\"7#7$ F+\"\"(7#7$\"\")\"\"!7#7$\"\"$F57#7$F+F+7#7$F&F27#7$F+F17#7$F%F57#7$\" \"&F57#7$F2\"\"'7#7$F2F17#7$\"\"*F27#7$F@F%7#7$F2F.7#7$F%F%7#7$F5F+7#7 $F5F&" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matcompL); " }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\"%\"\"\"7#7$\"\"$\"\"!7#7$ \"\"#\"\"(7#7$F-F)7#7$F.F*7#7$F&F-7#7$F)F%7#7$\"\"'F)7#7$F*\"\"&7#7$F& F97#7$\"\")F&7#7$F " 0 "" {MPLTEXT 1 0 18 "indices(matcompR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6 07#7$\"\"%\"\"\"7#7$\"\"$\"\"!7#7$\"\"#\"\"(7#7$F-F)7#7$F.F*7#7$F&F-7# 7$F)F%7#7$\"\"'F)7#7$F*\"\"&7#7$F&F97#7$\"\")F&7#7$F " 0 "" {MPLTEXT 1 0 18 "indices(matquatL); " }}{PARA 12 "" 1 "" {XPPMATH 20 "657#7$\"\"#\"\"&7#7$\"\"$\"\"'7#7$\" \"!F)7#7$\"\"\"F&7#7$F*F07#7$F0F)7#7$F&F07#7$F%F*7#7$F0\"\"%7#7$F%F;7# 7$F*F-7#7$F)F&7#7$\"\"(F07#7$F-F%7#7$F*F%7#7$F-F;7#7$F;F-7#7$FDF%7#7$F &F-" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matquatR);" }}{PARA 12 "" 1 "" {XPPMATH 20 "657#7$\"\"#\"\"&7#7$\"\"$\"\"'7#7$\"\" !F)7#7$\"\"\"F&7#7$F*F07#7$F0F)7#7$F&F07#7$F%F*7#7$F0\"\"%7#7$F%F;7#7$ F*F-7#7$F)F&7#7$\"\"(F07#7$F-F%7#7$F*F%7#7$F-F;7#7$F;F-7#7$FDF%7#7$F&F -" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 258 " " 0 "" {TEXT -1 23 "Last revised: 11-5-2002" }}{PARA 0 "" 0 "" {TEXT -1 952 "NOTES:\n\n1. The table name, e.g., Clifford, and the file name , e.g., Clifford.m must be the same.\n2. March commands useful in crea ting and viewing library file (issue in DOS window):\n\nC:\\Maple7>bin .wnt\\march -c Cliffordlib 20 - creates library in a existing empty directory \\Cliffordlib\nC:\\Maple7>bin.wnt\\march -l Cliffordlib - \+ list all entries in the library Cliffordlib\nC:\\Maple7>bin.wnt\\march -l Cliffordlib > list.txt - list all entries in the library Clifford lib and write them into file list.txt\nC:\\Maple7>bin.wnt\\march -d Cl iffordlib Clifford.m - delete Clifford.m from the library Cliffordlib \n\n3. Global variable savelibname is empty, but savelib() automatical ly assigns libname[1] to savelibname for the purpose of saving package there with the command savelib().\n4. Maple initialization file maple .ini contains libname augmented by the path and the directory name \\C liffordlib 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 module:\n###march('create',Cliffordlib,500);\n###savelib (Clifford,`Clifford.m`):\n############################################ ############" }}}}{MARK "0 322 0" 4479 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }