{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 "Error" -1 8 1 {CSTYLE "" -1 -1 "Courier" 1 10 255 0 255 1 2 2 2 2 2 1 1 1 3 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "Maple Output" -1 11 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "R3 Font 0" -1 256 1 {CSTYLE "" -1 -1 "Helvetica" 1 12 0 0 255 1 2 1 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "R3 \+ Font 2" -1 257 1 {CSTYLE "" -1 -1 "Times" 1 12 255 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "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_M8_07 .mws\n" }}{PARA 258 "" 0 "" {TEXT -1 30 "(Created: September 17, 2005) \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "########################### ##################################################\n# \+ #\n#DISCLAIM ER: #\n # \+ #\n#THERE IS NO WARRANTY FOR THE CLIFFORD, BIGEBRA, Cliplus, Oct onion, GTP #\n#PACKAGES TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AN D/OR OTHER PARTIES PROVIDE THE #\n#PROGRAM \"AS IS\" WITHOUT WARRANT Y OF ANY KIND, EITHER EXPRESSED OR IMPLIED, #\n#INCLUDING, BUT NOT LIM ITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY #\n#AND FITNESS F OR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY #\n#AND \+ PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE \+ #\n#DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR #\n#CORRECTION. \+ #\n################################################ #############################\n" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 322 "This is a listing (without examples) o f all procedures in a Maple package called 'CLIFFORD' (Version 8, Cop yright 1995-2005 by Rafal Ablamowicz, Tennessee Technological Univers ity), and Bertfried Fauser, Universit\"at Konstanz, for Maple 8. User will know which version he/she is using by using the 'version()' func tion." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 277 55 "The following procedures can use index such as K or -K:" }}{PARA 0 " " 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 66 "cmul[K](p1,p2,..., pn); ##Clifford product of p1,p2,...,pn in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 81 "&c[K](p1,p2,...,pn); ##Clifford product of p1,p2,...,pn i n 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 exp ected to be a diagonal matrix)" }}{PARA 0 "" 0 "" {TEXT -1 126 "&cQ[K] (p1,p2,...,pn); ##Clifford product of p1,p2,...,pn in Cl(K) (here K is expected to be a diagonal matrix), ampersand form" }}{PARA 0 "" 0 "" {TEXT -1 56 "cexp[K](p,N); ## exponential of p in Cl(K) up to order N " }}{PARA 0 "" 0 "" {TEXT -1 102 "cexpQ[K](p,N); ## exponential of p i n Cl(K) up to order N (here K is expected to be a diagonal matrix)" }} {PARA 0 "" 0 "" {TEXT -1 53 "climinpoly[K](p); ## minimal polynomial o f p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 91 "sexp[K](p,N); ## exponent ial 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 foll owing procedures can use name K or a numeric multiple of a name as an \+ optional argument:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 106 "LC(p1,p2,K); ##left contraction of p2 by p1 w.r.t. K\nRC (p1,p2,K); ##right contraction of p1 by p2 w.r.t. K" }}{PARA 0 "" 0 " " {TEXT -1 68 "cmulNUM(m1,m2,K); ##Clifford (numeric) product of m1 an d m2 in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 41 "reversion(p,K); ##revers ion of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 43 "cinv(p,K); ##Cliffor d inverse of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 73 "LCQ(p1,p2,K); \+ ##left contraction of p2 by p1 w.r.t. diagonal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 74 "RCQ(p1,p2,K); ##right contraction of p1 by p2 w .r.t. diagonal entries in K" }}{PARA 0 "" 0 "" {TEXT -1 46 "conjugatio n(p,K); ## conjugation of p in Cl(K)" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 279 86 "The folllowing procedures can pass on \+ name or a numeric multiple of a name via a list:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 121 "type([p,K],nilpotent); # # checks if p is nilpotent in Cl(K)\ntype([p,K],idempotent); ## checks if p is idempotent in Cl(K)" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 580 "\nProcedures that define types: `type/ climon`, `type/clipolynom`, `type/climatrix` as well as other procedur es such as 'reorder', 'wedge', etc., have been substantially revised t o improve efficiency and speed of the package. This work has been done together with Bertfried Fauser, Universit\"at Konstanz, in Cookeville on October 5, 2001. \n\nThis version includes \"Bigebra\" package tha t has been created together with Bertfried Fauser, Universit\"at Konst anz, Konstanz, Germany. Additional help pages have been written and ad ded to the database that explain the usage of this package." }{TEXT 276 0 "" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 301 "An additional feature in this version is an ability to display and change environmental variables. They can be displayed with proced ure CLIFFORD_ENV.\n\nThis package is made to run under Maple 8. It is available on a server of the Department of Mathematics, Tennessee T echnological 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 o rder to create a Maple file 'Clifford.m' containing the 'CLIFFORD' pac kage, execute this worksheet.\n\nTo load the package type:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">with(Cliff ord); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 189 "You will know if the package has been loaded because a list wi th Clifford procedures will be displayed on the screen. To check the \+ current version of the package, at the Maple prompt type " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 12 ">version( ) ;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 35 " Rafal Ablamowicz, Ph.D. and Chair " }}{PARA 258 "" 0 "" {TEXT -1 35 " Department of Mathematics, Box 5054" }}{PARA 258 "" 0 "" {TEXT -1 36 " Tennessee Technological University " }}{PARA 258 "" 0 "" {TEXT -1 21 "Cookeville, TN 38505 " }}{PARA 258 "" 0 "" {TEXT -1 24 "rablamowicz@t ntech.edu " }}{PARA 258 "" 0 "" {TEXT -1 25 "phone: USA (931) 372-356 9" }}{PARA 258 "" 0 "" {TEXT -1 23 "fax: USA (931) 372-6353" }}{PARA 0 "" 0 "" {TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 "restart :\nunprotect('Clifford','e','qi','qj','qk','Id','w');" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 989 "Clifford:=module()\n########################### ########\nexport `&m`, Bsignature, CLIFFORD_ENV, Kfield, LC, LCQ, RC, \+ RCQ, RHnumber, adfmatrix, all_sigs, beta_minus, beta_plus, buildm, byg rade, c_conjug, cbasis, cdfmatrix, cexp, cexpQ, cinv, clibilinear, cli collect, clidata, clilinear, climinpoly, cliparse, cliremove, clisolve , clisort, cliterms, cmul, cmulNUM, cmulQ, cmulRS, cmulgen, cocycle, c ommutingelements, conjugation,ddfmatrix, diagonalize, displayid, extra ct, factoridempotent, find1str, findbasis, gradeinv, init, isVahlenmat rix, isproduct, makealiases, makeclibasmon, matKrepr, maxgrade, maxind ex, mdfmatrix, minimalideal, ord, permsign, pseudodet, q_conjug, qdisp lay, qinv, qmul, qnorm, reorder, reversion, rmulm, rot3d, scalarpart, \+ sexp, specify_constants, spinorKbasis, spinorKrepr, squaremodf, subs_c lipolynom, useproduct, vectorpart, version, wedge, wexp, rd_clibasmon, rd_climon, rd_clipolynom;\n###################################\nlocal setup;\noption package, load=setup;\n" }}{PARA 258 "" 0 "" {TEXT -1 84 "No. 1. Name 'version' stores information about the current version of the package. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 25 "Typical use: version(); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1520 "version:= proc()\noptio ns `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: September 17, 2005` ;\nprint(`+++++++++++++++++++++++++++++++++++++++++++`);\nprint(`CLIFF ORD - A Maple 8 Package for Clifford Algebras with \"Bigebra\"`); \npr int(`(Version 8 with environmental variables given by CLIFFORD_ENV())` );\nprint(`Last revised: September 17, 2005 (Source file: clifford_M8_ 07.mws)`);\nprint(`Copyright 1995-2005 by Rafal Ablamowicz (*) and Ber tfried Fauser ($)`);\nprint(``);\nprint(`(*) Department of Mathematics , Box 5054`);\nprint(` Tennessee Technological University, Cookevil le, TN 38505`);\nprint(` tel: USA (931) 372-3569, fax: USA (931) 37 2-6353`);\nprint(` rablamowicz@tntech.edu`);\nprint(` http://mat h.tntech.edu/rafal/Cliff8/`);\nprint(`($) Universit\"at Konstanz, Fach bereich Physik, Fach M678`);\nprint(` 78457 Konstanz, Germany`);\np rint(` Bertfried.Fauser@uni-konstanz.de`);\nprint(` http://kaluz a.physik.uni-konstanz.de/~fauser/`); \nprint(``);\nprint(`If you \+ are a Clifford algebra pro, assign 'true' to '_prolevel' and see`);\np rint(`how much faster your computations will be! But watch your syntax !`);\nprint(`Use 'useproduct' to change value of _default_Clifford_pro duct in Cl(B) from`);\nprint(`cmulRS when B is symbolic to cmulNUM whe n B is numeric. Type ?cmul for help.`);\nprint(`Type CLIFFORD_ENV() to see current values of environmental variables.`); \nprint(`++++++++++ ++This is CLIFFORD version 8++++++++++++`);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 2. Procedure " }{TEXT 282 17 "specify_constan ts" }{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 origin ally known constants are stored in a global, non-protected variable 'c onstants' and must be saved separately, if needed. This procedure is \+ needed when sorting or collecting multivariate Clifford polynomials co ntaining expressions 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 constants of length 2 or more known to Maple as shown below . If these constants of length 2 or more are not defined as Maple con stants, then some procedures might yield error messages (although an a ttempt has been made to avoid this problem). Constants of length one a re automatically assumed to be Maple constants. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: specify_co nstants(a, b, B, aa); " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 186 "NOTE: from now on, extra spaces have been ad ded for the Reader's convenience in the sequence of input variables as in the above example. These spaces are not needed or required by Mapl e." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 373 "specify_constants:=proc(a1::anything) global constants;\noptions \+ `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n #############################################\nconstants:=op(\{constan ts,args\});\nprintf(\"Maple now knows the following constant(s): %q\\n \",constants);\nreturn NULL;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 21 "No. 3. The procedure " }{TEXT 283 6 "cbasis" }{TEXT -1 793 " wr ites a canonical basis for a Clifford algebra Cl(B) over a vector spac e V endowed with a bilinear form B. The dimension of V is specified b y a Maple global variable 'dim' where 1 <= dim <= 9. This procedure c an be used with one or two arguments as, for example, in cbasis(4) or \+ cbasis(4, 2). In the first case, it returns a list of all basis eleme nts in the Clifford algebra Cl(4). In the second case, it returns a li st of basis elements in the 2-vector subspace of Cl(4). Below, 'Id' st ands for the algebra unit element and 'w' denotes wedge/exterior produ ct in the Clifford algebra. An option 'even' allows one to create a ba sis in the even subalgebra of the given Clifford algebra as in cbasis( 3, 'even'). In fact, 'even' can be replaced with any name which evalu ates to a string. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1877 "cbasis:= proc(a1::nonnegint,a2::\{string,symbol,nonnegint\})\nlocal i,k,X,XX,YY ,L,Leven,Lodd,bas,nxt,ind,start; global choose,e;\noptions `Copyright \+ (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`,remember;\ndescription `Last revised: September 17, 2005`;\n## ###########################################\nif a1>9 then \n error \+ \"first argument must be between 0 and 9 inclusive but received %1 ins tead\",a1 \nend if;\nif a1=0 and nargs=1 then return [Id] end if;\nif \+ nargs=2 and type(a2,\{string,symbol\}) then do\n L:=procname(a1):\n \+ Leven:=[Id]:Lodd:=[]:\n if nops(L) > 1 then\n for i from 2 to no ps(L) do\n if type(length(L[i]),odd) then Leven:=[op(Leven),L[i] ] else\n Lodd:=[op(Lodd),L[i]]\n end if \n end do \n end if; \nif args[2]='even' then return Leven \n elif args[2]='odd' then return Lodd\n else error \"secon d argument must be an integer or a string 'even' or 'odd' but received %1 instead\",args[2]\nend if\nend do \nend if;\nfor k from 0 to a1 do \n X[k]:=combinat[choose]([seq(i,i=1..a1)],k) \nend do;\nif not na rgs = 1 and not nargs = 2 then \n error \"one or two arguments are n eeded as input but received %0 instead\",args\nelif nargs = 1 then XX: =[seq(op(X[k]),k=0..a1)] \nelse if not a2 >= 0 or not a2 <= a1 then \n error \"second argument must satisfy: 0 <= 'a2' <= %1 but received %2 instead\",a1,a2 \nelse XX:=X[a2] \nend if \nend if;\nYY:=array(1..no ps(XX),[]);start:=1:\nif XX[1] = [] then \n YY[1]:=Id; \n start:=2 \nend if;\nfor k from start to nops(XX) do\n ind:=XX[k][1];\n i f ind=10 then \n bas:=e||0 else bas:=e||ind \n end if;\nfor i from 2 to nops(XX[k]) do \n ind:=XX[k][i]:\n if ind=10 then nxt :=e||0 else nxt:=e||ind end if:\n bas:=cat(bas,\"w\",nxt): \n \+ end do;\nYY[k]:=bas;\nend do:\nYY:=convert(YY,list);\nprotect(op(YY)) ; #protect basis monomials\nreturn YY\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 4. Procedure " }{TEXT 284 8 "find1str" }{TEXT -1 327 " finds all locations of the first string of length one in the sec ond string of length at least one. It returns a set of these positions . If the first string is not found then it returns \{0\}. This proced ure is primarily for internal use in 'type/clibasmon' and 'cliparse'. \+ \nTypical use: find1str(e,e1we2we3); find1str(w,e1we2);" }{MPLTEXT 0 21 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 664 "find1str:=proc(a1::sym bol,a2::symbol) local ns,p,p1,ap,le2;\nglobal _prolevel;\noptions `Cop yright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`,remember;\ndescription `Last revised: September 17, 200 5`;\n#############################################\nle2:=length(a2):\n if _prolevel=false then\nif length(a1) <> 1 or le2<1 then \n error \+ \"first string must be of length 1 but received %1 instead\",a1 \nend if;\nend if;\np:=SearchText(a1,a2):\nap:=\{p\}:p1:=p:\nwhile p<>0 and p10 then p1:=p1+p;\n ap:=ap union \{p1\} \n \+ end if;\nend do;\nreturn ap\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 5. Function " }{TEXT 285 8 "cliparse" }{TEXT -1 349 " check s user's input for correct spelling of basis monomials. When unable t o decide if the given input is correct, it tells the user to check spe lling or define the given string as a Maple constant. If the spelling \+ is correct, it returns true; if it is not correct, it returns a set of suspect words.\n \nTypical use: cliparse(e1+e2we3+2*Pi*B[1,2]);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1181 "cliparse:=proc(a1::anything) loca l x,S1,S2,p,S;\nglobal _prolevel,_scalartypes;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: September 17, 2005`;\n############## ###############################\nif _prolevel then return true end if; \nif type(a1,_scalartypes) then return true end if;\np:=remove(type,a1 ,_scalartypes):S1:=\{op(p)\}:\nfor x in S1 do \n if type(x,_scalart ypes) or type(x,clibasmon) then S1:=S1 minus \{x\} end if;\nend do; \n S2:=map(op,S1); \nfor x in S2 do \n if type(x,_scalartypes) or type (x,clibasmon) then S2:=S2 minus \{x\} end if;\nend do;\nS:=remove(hast ype,map(op,\{op(expand(p))\}),\{op(_scalartypes),clibasmon\});\nfor x \+ in S do \n if find1str(e,x)=\{0\} and x<>'Id' then S:=S minus \{x\} end if;\nend do;\nif S=\{\} then return true end if;\nS1:=select(type ,S,procedure):\nif S1 <> \{\} then\n error \"procedure name %1 that \+ has been found in input is not allowed as a symbolic coefficient\",op( S1)\nend if;\nif nops(S)=1 then \n error \"check spelling of %1 or d efine it as a constant or an alias\",op(S)\nelse \n error \"check sp elling of %1 or define them as constants or aliases\",op(S) \nend if; \nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 6. Function " } {TEXT 286 9 "displayid" }{TEXT -1 186 " replaces a user-entered Cliffo rd scalar with the scalar times the unit element 'Id'. It may also be \+ applied to matrices with Clifford algebra entries.\n\nTypical use: dis playid(e1+2*Pi);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 623 "displayid:=p roc(a1::\{array,matrix,algebraic\}) local KK,p;\noptions `Copyright (c ) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reser ved.`;\ndescription `Last revised: September 17, 2005`;\n############# ################################\nKK:=proc() if type(args[1],cliscalar ) then return args[1]*Id \n elif hastype(args[1],clibasmon) \+ then return args[1] \n end if \nend proc:\nif type(a1,\{arra y,matrix\}) then return map(procname,a1) end if;\np:=expand(a1):\nif t ype(p,\{`*`,cliscalar,clibasmon,climon\}) then return KK(p) \nelif typ e(p,\{`+`\}) then return map(KK,p) \nelse return a1 \nend if;\nend pro c:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 7. Procedure " }{TEXT 287 8 "cliterms" }{TEXT -1 222 " identifies Clifford basis elements in the given Clifford polynomial.\n\nNOTE: 'cliterms' also works with terms \+ of type cliprod and it finds correctly terms involving such expression s. \n\nTypical use: cliterms(2*Pi+2*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1021 "cliterms:= proc(a1::anything) local S1,S2,S3,x,p,Cl iplusflag;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: Se ptember 17, 2005`;\n#############################################\nCli plusflag:=assigned(Cliplus):\nif hastype(a1,cliprod) and not Cliplusfl ag and _warnings_flag then \n WARNING(`argument to 'cliterms' contai ns type cliprod. Load 'Cliplus' to extend functionality of CLIFFORD. \+ Type ?cliprod for help.`)\nend if;\nif type(a1,\{clibasmon,cliprod\}) \+ then return \{a1\} end if;\np:=displayid(simplify(a1)):\nif hastype(p, cliprod) then \n S1:=remove(type,\{op(p)\},cliscalar);\n S2:=selec t(hastype,S1,\{clibasmon,climon,cliprod\});\n S3:=\{\}:\n while no t S2=\{\} do\n S3:=S3 union select(type,S2,\{clibasmon,cliprod \});\n S2:=select(hastype,map(op,remove(type,S2,\{clibasmon,cl iprod\})),\{clibasmon,cliprod\});\n end do;\nreturn S3\nend if;\nx:= 'x':\nS1:=remove(type,\{op(p)\},cliscalar);\nreturn \{seq(select(hasty pe,x,clibasmon),x=S1)\}\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 8. Procedure " }{TEXT 288 11 "clibilinear" }{TEXT -1 360 " makes \+ any procedure K specified as the third argument bilinear with respect \+ to Clifford scalars in the first two arguments. The first two argument s are of the type clipolynom, i.e., Clifford polynomials. The third ar gument is a string or a procedure.\nIt can handle terms involving elem ents of type cliprod.\n\nTypical use: clibilinear(e1+2*e2we3,Id+2*e2+e 3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 924 "clibilinear:=proc(a1,a2 ,a3::\{procedure,name,symbol,matrix,array\}) \n local tail ,p1,p2,S1,S2,S12,res,x,y,cli1,cli2,co1,co2;\noptions `Copyright (c) 19 95-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: September 17, 2005`;\n################# ############################\nif simplify(a1)=0 or simplify(a2)=0 then return 0 end if; \np1:=clicollect(a1):\np2:=clicollect(a2):\n tail:= args[4..-1];\n if type(p1,\{climon,cliprod\}) then S1:=[p1] else S1:= [op(p1)] end if:\n if type(p2,\{climon,cliprod\}) then S2:=[p2] else \+ S2:=[op(p2)] end if:\n S12:=[seq(seq([x,y],x=S1),y=S2)];#this list wi ll be huge for long polynomials\n res:=0:\n for x in S12 do \n cl i1:=select(type,x[1],\{cliprod,clibasmon\}):\n cli2:=select(type,x[ 2],\{cliprod,clibasmon\}):\n co1:=coeff(x[1],cli1):\n co2:=coeff (x[2],cli2):\n res:=res+co1*co2*a3(cli1,cli2,tail):\n end do:\n r eturn res;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 17 "No. 9. Proce dure " }{TEXT 289 9 "clilinear" }{TEXT -1 336 " makes any procedure K \+ specified as the second argument linear with respect to Clifford scala rs (elements of type cliscalar). It can now distribute over Clifford p olynomials with elements of `type/cliprod`. Any additional parameters \+ are passed on to the procedure entered as the second argument.\nTypica l use: clilinear(a*e1+2*e2we3,K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 623 "clilinear:=proc(a1::\{symbol,cliscalar,clibasmon,climon,clipolyno m\},a2::\{name,procedure\}) \nlocal tail,p1,S1,res,x,cli1,co1;\noption s `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. A ll rights reserved.`;\ndescription `Last revised: September 17, 2005`; \n#############################################\ntail:=args[3..-1];\ni f type(a1,cliscalar) then return a1*a2(Id,tail) end if;\np1:=displayid (a1):\nif type(p1,climon) then S1:=[p1] else S1:=[op(p1)] end if:\nres :=0:\nfor x in S1 do\n cli1:=select(hastype,x,\{clibasmon,cliprod\} ):\n co1:=coeff(x,cli1); \nres:=res+co1*a2(cli1,tail):\nend do:\nre turn res\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 10. Proced ure " }{TEXT 290 7 "clisort" }{TEXT -1 312 " sorts the given multivari ate Clifford polynomial with respect to the Clifford indetereminates f ound in the expression via the procedure 'cliterms'. It puts scalar co efficients of the type cliscalar in front of the Clifford basis monomi als. It may also be applied to matrices with entries in a Clifford alg ebra. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 40 "Typical use: clisort(2*e1we2 - e1*b); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 441 "clisort:=proc(p::algebraic) local L,N;\noptions `Cop yright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: September 17, 2005`;\n#### #########################################\nif type(p,matrix) then retu rn map(procname,p) end if;\nif type(eval(p),\{climon,clipolynom\}) or \+ hastype(eval(p),cliprod) then\n L:=cliterms(expand(displayid(p)));\n return sort(p,L);\nend if:\nreturn p\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 11. Procedure " }{TEXT 291 10 "clicollect" } {TEXT -1 382 " reorders monomial terms in standard order and then coll ects them in a multivariate Clifford polynomial. It may also be applie d to matrices with entries in a Clifford algebra. It will simplify 6 + 7*Id to 13*Id. It collects now terms of type cliprod, if present.\n \nNOTE: 'clicollect' also works with terms of type cliprod and it coll ects correctly terms involving such expressions. " }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: clicolle ct(e1 + a*e1 - e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 498 "clic ollect:=proc(a1::algebraic) local p,L; \noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: September 17, 2005`;\n##################### ########################\nif type(a1,matrix) then return map(procname, a1) end if;\np:=expand(a1):\nif type(p,cliscalar) then return p*Id\nel if type(p,clipolynom) then \n L:=cliterms(p);\n return map(sim plify,collect(displayid(p),L,'distributed'))\nelse return args[1] \nen d if\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 23 "No. 12. The proce dure " }{TEXT 292 3 "ord" }{TEXT -1 319 " returns an ordered list of p ositions in a monomial, e.g., e1we2, where vector indices are found. Then, nops(ord(e1we2)) can be used to find the order of the monomial . Note that for consistency we have ord(Id) = ord(numeric) = ord(nume ric*Id) = ord(cliscalar)=[] where cliscalar is any object of the type \+ cliscalar." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 35 "This procedure is for internal use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 388 "ord:=proc(a1) loca l v,k;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Septem ber 17, 2005`;\n#############################################\nif type (a1,cliscalar) then return [] end if;\nv:=select(type,a1,clibasmon);\n if v = Id then return [] end if;\nk:='k':\nreturn [seq(2+3*k,k=0..((le ngth(v)+1)/3-1))]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 1 3. Procedure " }{TEXT 293 9 "cliremove" }{TEXT -1 193 " removes one s ymbol 'ei' from the location specified by the procedure 'ord'. \n(NOTE : procedure 'ord' specifies location of the index 'i' in 'ei'.) This \+ procedure is primarily for internal use." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 580 "cliremove:=proc(p::posint,s ::symbol) local S1,S2;global _prolevel;\noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`,re member;\ndescription `Last revised: September 17, 2005`;\n############ #################################\nif not _prolevel then\n if s=Id t hen error \"second argument must be Grassmann basis monomial of rank > = 1\" end if;\nend if;\nS2:=substring(s,(p+2)..length(s));\nS1:=substr ing(s,1..(p-3));\nif length(S2)=0 and S1 <> s then return S1 \n elif S1 = s then return S2 \n else return cat(S1,\"w\",S2); \nend if;\n end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. Procedure " } {TEXT 294 7 "extract" }{TEXT -1 445 " extracts indices of a monomial ( or a constant times a monomial) and it returns them as a list of strin gs. If necessary, they can be returned as a list of integers if optio n 'integers' is selected (in fact, any name which evaluates to a strin g may be used as the option). Indices could be now integers, letters, or they could be mixed. Note that extract(Id) = [] and extract(numeri c) = extract(numeric*Id) = [] results in no vector indices. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 63 "Typic al use: extract(2*e1we2); or extract(e2we3, \"integers\"); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 731 "extract: =proc(a1,a2) \nlocal v,k,inds;global _prolevel,str_to_int;\noptions `C opyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`,remember;\ndescription `Last revised: December 2, 200 2`;\n#############################################\nif type(a1,cliscal ar) or (type(a1,symbol) and length(a1)=1) then return [] \nelif\n ty pe(a1,\{climon,clibasmon\}) then v:=select(type,a1,clibasmon):\nelse \+ \n error \"wrong argument: %1\",a1 \nend if;\nif v = Id then return \+ [] end if;\ninds:=map(convert,remove(member,StringTools:-Explode(v),\{ \"e\",\"w\"\}),symbol);\nif nargs=1 then return inds \n elif type(a2 ,symbol) then \n return map(parse,inds)\n else error \"wrong option or number of arguments\" \nend if;\nend proc:\n" }}{PARA 258 " " 0 "" {TEXT -1 19 "No. 15. Procedure " }{TEXT 295 7 "reorder" } {TEXT -1 330 " reorders Clifford monomials in the given Clifford polyn omial using standard ordering and calculates sign of each permutation, e.g., reorder(e1we3we2) = -e1we2we3, reorder(e2we1 + 2*e1we5we2) = -e 1we2 - 2*e1we2we5. If any one of the indices of the monomial is a lett er, e.g., reorder(eiwe3) = eiwe3, reorder returns its argument. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 139 "Reor der now can order monomials and polynomials with symbolic coefficients , e.g. reorder(ejwei) = -eiwej, using the lexicographic order. " }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typic al use: reorder(e2we1 + 2*Id + e4we3we1); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1077 "reorder:=proc(a1::algeb raic) \n local L1,L2,N,newbas,f,a,x,K,dummy_set,n12,s12,ss;\n \+ global B,dim_V;\noptions `Copyright (c) 1995-2005 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: September 17, 2005`;\n##################################### ########\nif type(a1,\{matrix,`+`,`*`\}) then return map(procname,a1) \+ end if; \nL1:=Clifford:-extract(a1);\nN:=nops(L1);\nif N>9 then error \+ \"detected basis monomial of grade higher than 9 in the input\" end if ;\nif N=0 or N=1 then return a1 end if;\nn12,s12:=selectremove(member, L1,\{`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`\}):\n#s12:=remove(member,L1, \{`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`\}):\nL2:=[op(sort(n12)),op(sort( s12))];\nf:=proc() end proc:\nfor ss from 1 to N do\n f(L2[ss]):=L1[s s];\nend do:\ndummy_set:=convert(L1,set):\nK:=0:\nwhile dummy_set <> \+ \{\} do\n a:=dummy_set[1]:\n dummy_set:=dummy_set[2..-1];\n x:=a:\n while f(x)<>a do\n x:=f(x);\n dummy_set:=dummy_set minus \+ \{x\};\n K:=K+1;\n end do:\nend do:\nnewbas:=cat(e||(op(L2[1..-2 ]))||w,e,L2[-1]):\nreturn (-1)^K*newbas\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 35 "No. 16. Defining a useful function " }{TEXT 296 8 "m axindex" }{TEXT -1 226 " which finds the greatest index in the given C lifford polynomial or in the given list or set of Clifford monomials. \+ It returns 0 for a Clifford scalar (an element of type cliscalar).\n\n Typical use: maxindex(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 814 "maxindex:=proc(a1::\{cliscalar,clibasmon,climon,clip olynom,list,set\}) \nlocal inds,mons,symbinds;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: September 17, 2005`;\n############## ###############################\nif type(a1,cliscalar) or a1=Id then r eturn 0 elif\n type(a1,list) then return max(op(convert(map(procname ,a1),set))) elif\n type(a1,set) then return max(op(map(procname,a1)) ) else \n mons:=cliterms(a1);\n inds:=map(op,map(Clifford:-extract ,mons,'integers'));\n symbinds:=remove(type,inds,integer);\n if sy mbinds = \{\} then\n if inds=\{\} then return 0 else return max(o p(inds)) end if;\n else\n error \"cannot determine maximum inde x because input contains symbolic index or indices\"\n end if;\n en d if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 35 "No. 17. Defining \+ a useful function " }{TEXT 297 8 "maxgrade" }{TEXT -1 176 " which find s the maximum grade in the given Clifford polynomial. It returns 0 fo r a Clifford scalar (an element of type cliscalar).\n\nTypical use: ma xgrade(a*Id+6+2*Pi*e1we2);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 401 "ma xgrade:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) local S;\n options `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fau ser. All rights reserved.`;\ndescription `Last revised: September 17, \+ 2005`;\n#############################################\nif type(eval(a1 ),cliscalar) then return 0 end if;\nS:=\{op(cliterms(eval(a1)))\}:\nre turn max(op(map(nops,map(Clifford:-extract,S))))\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 19 "No. 18. Procedure " }{TEXT 298 2 "LC" }{TEXT -1 233 " defines a left contraction between any multivector u a nd a multivector v, i.e., multivector u acts on the multivector v from the left. This procedure is now bilinear in both arguments. It can \+ accept third argument such as K or -K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 46 "Typical use: LC(e1 + 2*e2, e1we3 + b*e2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2318 "LC:=proc(x1:: \{cliscalar,clibasmon,climon,clipolynom\},\n y1::\{cliscalar,c libasmon,climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,term,l name,res,coB,nameB,x,y;\n global _CLIENV,B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: September 17, 2005`;\n############## ###############################\nif nargs=2 then\n coB:=1:\n nam eB:=`B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{ name,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3 ];\n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name, symbol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3]) \},numeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric)); \n lname:=args[3]:\n else \n error \"wrong type of thir d argument in LC. See ?LC for more help.\" \n end if;\nelse\n err or \"two or three arguments expected in LC. See ?LC for more help.\"\n end if;\n################################\nx,y:=expand(x1),expand(y1) : ##NEW\n if type(x,clibasmon) then\n if type(y,clibasmon) then\n \+ lst1:=Clifford:-extract(x,'integers');\n lst2:=Clifford:-ext ract(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]]*_CLIEN V[_QDEF_PREFACTOR]^(j-1)*\n makeclibasmon([op (subs(lst2[j]=NULL,lst2))]),j=1..N2));\n return reorder(res) \+ \n else\n res:=\nprocname(makeclibasmon(lst1[1..-2]),procnam e(makeclibasmon([lst1[-1]]),y,lname),lname);\n return reorder( res)\n end if;\n elif type(y,climon) then\n term,cf:=se lectremove(type,y,clibasmon);\n return expand(cf*procname(x,te rm,lname))\n elif type(y,clipolynom) then\n return add(pr ocname(x,i,lname),i=[op(y)])\n elif type(y,cliscalar) then \n \+ return displayid(scalarpart(x)*y)\n end if; \n elif type(x, climon) then\n term,cf:=selectremove(type,x,clibasmon);\n return expand(cf*procname(term,y,lname))\n elif type(x,clipolynom) then\n \+ return add(procname(i,y,lname),i=[op(x)])\n elif type(x,cliscalar) \+ then \n return x*reorder(y)\n end if;\nerror \"Got input %1 and % 2 but LC can only process constants and Clifford numbers\",x,y;\nend p roc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 19. Procedure " }{TEXT 299 3 "LCQ" }{TEXT -1 270 " is a special version of 'LC' and gives lef t contraction in the orthogonal Clifford algebra Cl(Q) of the quadrati c form Q defined via the symmetric part g of B as Q(x) = g(x, x) = B(x , x). It can accept name as a third optional argument or a numeric mu ltiple of a name." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 76 "Proposed by Yvon Siret, Universite Joseph Fourier, Gre noble, France. Thanks!" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 82 "Typical use: LCQ(e1 + 2*e2, e1we3 + b*e2we3);\nLC Q(e1 + 2*e2, e1we3 + b*e2we3,K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1796 "LCQ:=proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n \+ y::\{cliscalar,clibasmon,climon,clipolynom\}) \n local ii,N,L,m ,Sxy,symbxy,lname,coB,nameB;global B:\noptions `Copyright (c) 1995-200 5 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: September 17, 2005`;\n####################### ######################\nif nargs=2 then\n coB:=1:\n nameB:=`B`: \+ \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{name,symb ol,matrix,array\}) then\n coB:=1:\n nameB:=args[3];\n \+ lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,symbol,ma trix,array\})) then\n coB:=op(select(type,\{op(args[3])\},numeri c));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n \+ lname:=args[3]:\n else \n error \"wrong type of third argumen t in LCQ. See ?LCQ for more help.\" \n end if;\nelse\n error \"tw o or three arguments expected in LCQ. See ?LCQ for more help.\"\nend i f;\n################################\nSxy:=remove(type,map(op,\{op(x), op(y)\}),cliscalar);\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers' ));\nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n ret urn LC(x,y,lname) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when both x and y have maxindex=0\nif type(evalm(lname),matrix) then \n N:=li nalg[coldim](evalm(lname)):\n if m>N then \n error \"input cont ains index larger than size of bilinear form %1\",lname \n end if;\n end if:\nif type(lname,\{name,symbol,array,matrix\}) then\n L:=seq(l name[ii,ii],ii=1..m);\n return LC(x,y,linalg[diag](L))\nelif \n ty pe(lname,`&*`(numeric,\{name,symbol,array,matrix\})) then\n coB:=op( select(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(ln ame)\},\{name,symbol,array,matrix\}));\n L:=seq(coB*nameB[ii,ii],ii= 1..m);\n return LC(x,y,linalg[diag](L))\n end if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 19 "No. 20. Procedure " }{TEXT 300 2 "RC" }{TEXT -1 241 " defines a right contraction between any multivector u \+ and a multivector v, i.e., multivector u acts on the multivector v fro m the right. This procedure is now bilinear in both arguments. It ca n accept third optional argument like B or -B." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 258 46 "Typical use: RC(e1 + 2*e 2, e1we3 + b*e2we3); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2281 "RC:=pr oc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n y::\{clisca lar,clibasmon,climon,clipolynom\})\n local N1,N2,lst1,lst2,i,j,cf,ter m,lname,res,coB,nameB;\n global _CLIENV,B;\noptions `Copyright (c) 19 95-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: September 17, 2005`;\n################# ############################\nif nargs=2 then\n coB:=1:\n nameB: =`B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{nam e,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3]; \n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,sy mbol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\} ,numeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \n error \"wrong type of third \+ argument in RC. See ?RC for more help.\" \n end if;\nelse\n error \"two or three arguments expected in RC. See ?RC for more help.\"\nen d if;\n################################\n if type(x,clibasmon) then\n if type(y,clibasmon) then\n lst1:=Clifford:-extract(x,'intege rs');\n lst2:=Clifford:-extract(y,'integers');\n N1:=nops(ls t1);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(c oB*nameB[lst1[-i],lst2[1]]*_CLIENV[_QDEF_PREFACTOR]^(i-1)*\n \+ makeclibasmon([op(subs(lst1[-i]=NULL,lst1))]),i=1..N1));\n \+ return reorder(res) \n else\n res:=procname(pro cname(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:=selectre move(type,y,clibasmon);\n return expand(cf*procname(x,term,lname) )\n elif type(y,clipolynom) then\n return add(procname(x,i,lna me),i=[op(y)])\n elif type(y,cliscalar) then return reorder(x)*y \n end if;\n elif type(x,climon) then\n term,cf:=selectremove(ty pe,x,clibasmon);\n return expand(cf*procname(term,y,lname))\n elif type(x,clipolynom) then\n return add(procname(i,y,lname),i=[op(x)] )\n elif type(x,cliscalar) then \n return displayid(x*scalarpart(y ))\n end if;\nerror \"Got input %1 and %2 but can only process const ants 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 optional argument such as K \+ or -K.\n" }{TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1801 "RCQ:=p roc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n y::\{clis calar,clibasmon,climon,clipolynom\}) \n local ii,N,L,m,Sxy,symbxy, lname,coB,nameB;global B:\noptions `Copyright (c) 1995-2005 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: September 17, 2005`;\n################################### ########## \nif nargs=2 then\n coB:=1:\n nameB:=`B`: \n lnam e:=`B`: \nelif nargs=3 then\n if type(args[3],\{name,symbol,matrix, array\}) then\n coB:=1:\n nameB:=args[3];\n lname:=a rgs[3];\n elif type(args[3],`&*`(numeric,\{name,symbol,matrix,array \})) then\n coB:=op(select(type,\{op(args[3])\},numeric));\n \+ nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=arg s[3]:\n else \n error \"wrong type of third argument in RCQ. \+ See ?RCQ for more help.\" \n end if;\nelse\n error \"two or three arguments expected in RCQ. See ?RCQ for more help.\"\nend if;\n###### ##########################\nSxy:=remove(type,map(op,\{op(x),op(y)\}),c liscalar);\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers'));\nsymbx y:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n return RC(x,y ,lname) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when both x and y h ave maxindex=0\nif type(evalm(lname),matrix) then \n N:=linalg[coldi m](evalm(lname)):\n if m>N then \n error \"input contains i ndex larger than size of bilinear form %1\",lname \n end if:\nend if :\nif type(lname,\{name,symbol,array,matrix\}) then\n L:=seq(lname[i i,ii],ii=1..m);\n return RC(x,y,linalg[diag](L))\nelif \n type(lna me,`&*`(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 RC(x,y,linalg[diag](L))\n end if;\nend proc:" }}{PARA 258 "" 0 "" {TEXT -1 19 "\nNo. 22. Procedure " }{TEXT 303 8 "gradeinv" } {TEXT -1 133 " is the grade involution in the Clifford algebra,i.e., i t reverses signs of odd elements and leaves signs of even elements unc hanged." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "Typical use: gradeinv(e1 + e1we2 - 4*e3we4); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 554 "gradeinv:=proc(a1::\{matrix,cliscalar,clibas mon,climon,clipolynom\}) global _CLIENV;\noptions `Copyright (c) 1995- 2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: September 17, 2005`;\n################### ##########################\nif type(a1,matrix) then return map(procnam e,a1) end if;\n#if not assigned(_CLIENV) then _CLIENV[_QDEF_PREFACTOR] :=-1 end if;\nif type(a1,clibasmon) then return (_CLIENV[_QDEF_PREFAC TOR])^maxgrade(a1)*a1 \n else return clilinear(a1 ,procname) \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No . 23. Define the " }{TEXT 304 5 "wedge" }{TEXT -1 1306 " product of an y number of Clifford polynomials. The infix form of this associative \+ multiplication is `&w`. Thus, e1 &w e2 = wedge(e1, e2), etc. Via the procedure 'rmulm' described below, wedge multiplication may be applie d to matrices with entries in a Clifford algebra or in an exterior alg ebra.\n\nNew feature: When the dimension of the vector space is known, either from the size of the matrix B or from the global parameter dim _V that can be set by the user, the output of the procedure does not i nclude terms of grade higher than the dimension of the vector space in case symbolic indices are used. \n\nThe default value of this global \+ variable is 9 and it it set by the initialization file when Clifford i s loaded.\n\nWhen the procedure is invoked, it checks whether the bili near form B has been defined. If yes, the procedure checks whether the size of B is less than the current value of dim_V. If again yes, a wa rning message is issued by the procedure and the value of dim_V is red uced. If the size of B is larger than the current value of dim_V, no w arning message is issued and the value of dim_V is increased to linal g[coldim](B).\n\nThe warning message can be supressed by addign 'false ' to a global parameter _warnings_flag whose default value is set to t rue by the Clifford initialization file." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 96 "Typical use: wedge(e1 + e2, e 4 + e1we2); wedge(e2 + 2*e1, e3, e4); (e2 + 2*e1) &w (e3 + 2*); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3063 "wedge:=proc(a1::\{cliscalar,cli basmon,climon,clipolynom\},\n a2::\{cliscalar,clibasmon,cli mon,clipolynom\}) \nlocal ii,kk,wedge2,pi,p1,p2,i1,i2,i12,n12,maxindex flag,expr,maxin;\nglobal dim_V,B,_warnings_flag;\noptions `Copyright ( c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: September 17, 2005`;\n############ #################################\nkk:='kk':\nif member(0,[args]) then return 0 \nelif \n remove(type,\{args\},cliscalar)=\{\} then return product(args[kk],kk=1..nargs)\nend if;\nif type(B,matrix) then\n if linalg[coldim](B)<>dim_V then \n if linalg[coldim](B) < dim_V th en\n dim_V:=linalg[coldim](B);\n if _warnings_flag the n\nprintf(\"Warning, since B has been (re-)assigned, value of dim_V ha s been reduced by 'wedge' to %g\\n\",dim_V);\n end if;\n eli f linalg[coldim](B)>dim_V then\n dim_V:=linalg[coldim](B);\n \+ end if;\n end if;\n end if; \nif not type(dim_V,Range(0,10)) or \n not type(dim_V,posint) then\n error \"value of dim_V must be a po sitive integer between 1 and 9, inclusive, but current value of dim_V \+ is %1\",dim_V\nend if;\n################\ni12:=\{\}:\nfor ii from 1 to nargs do\n pi:=args[ii]: \n i12:=i12 union map(op,map(Clifford: -extract,cliterms(pi),'integers')):\nend do;\nn12:= select(member,i12, \{1,2,3,4,5,6,7,8,9\}):\nif not n12=\{\} then\n maxin:=max(op(n12)); \n maxindexflag:=evalb(maxin > dim_V);\nelse maxindexflag:=false:\n end if:\nif maxindexflag then \n error \"argument(s) contain(s) inde x larger then current value of dim_V which is now %1. To complete comp utation, increase value of dim_V or assign square matrix of size at le ast %2 by %3 to bilinear form B\",dim_V,maxin,maxin\nend if;\n######## ########\nwedge2:=proc() local expr,i1,i2,n1,n2,i12,s12,symbindexflag; global dim_V;\n i1:=\{op(Clifford:-extract(args[1]))\};n1:=nops(i1):\n i2:=\{op(Clifford:-extract(args[2]))\};n2:=nops(i2):\n if args[1]=Id \+ then \n if n2>dim_V then return 0 else return args[2] end if;\n end if;\n if args[2]=Id then \n if n1>dim_V then return 0 else return \+ args[1] end if;\n end if;\n i1:=\{op(Clifford:-extract(args[1]))\}; \n i2:=\{op(Clifford:-extract(args[2]))\};\n i12:=i1 union i2;\n \+ s12:= remove(member,i12,\{`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`\}):\n \+ symbindexflag:=evalb(not s12=\{\}):\n if i1 intersect i2 <> \{\} th en return 0 end if;\n if symbindexflag and nops(i1)+nops(i2) > dim_V then return 0 end if;\nreturn reorder(cat(args[1],\"w\",args[2]));\ne nd proc:\n################\nif nargs=1 then return args\nelif nargs=2 \+ then p1:=displayid(a1):\n p2:=displayid(a2):\n \+ expr:=clibilinear(p1,p2,wedge2);\n if hast ype(expr,trig) then \n return clicollect(map(combi ne,clicollect(expr),trig))\n else \n \+ return reorder(expr)\n end if;\nelse expr:=procna me(procname(a1,a2),args[3..nargs]):\n if hastype(expr,trig) then \+ \n return clicollect(map(combine,clicollect(expr),trig))\n \+ else \n return reorder(expr)\n end if;\nend if;\nend proc: \n" }}{PARA 0 "" 0 "" {TEXT 269 29 "No. 24. Ampersand version of " } {TEXT 307 5 "wedge" }{TEXT 308 38 ". (Has been moved to Clifford:-setu p)\n" }}{PARA 0 "" 0 "" {TEXT 260 18 "No. 25. Procedure " }{TEXT 305 8 "permsign" }{TEXT 306 118 " computes sign of a permutation that sort s a list of indices.\n\nTypical use: permsign([1,3,2]); permsign([j,1, i,k,2]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 882 "permsign:=proc(L::li st) local newbas,ss,a,n12,s12,L1,L2,N,f,dummy_set,K,x;\noptions `Copyr ight (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: September 17, 2005`;\n###### #######################################\nL1:=L:\nN:=nops(L1):\nif N=1 \+ then return 1 end if:\n################## new\nn12,s12:=selectremove(m ember,L1,\{1,2,3,4,5,6,7,8,9\});\n#s12:=remove(member,L1,\{1,2,3,4,5,6 ,7,8,9\});\nL2:=[op(sort(n12)),op(sort(s12))];\n################## new \nf:=proc() end proc:\nfor ss from 1 to N do\n f(L2[ss]):=L1[ss];\nen d 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 "cmulN UM" }{TEXT -1 148 " calculates Clifford product between any two Cliffo rd monomials using the recursivelyChevalley's definition of the Cliffo rd product: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 93 " \+ xu = wedge(x, u) + LC(x, u) = x &w u + LC(x, u) " }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 477 "where x is a ve ctor 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 t he left contraction of u by x. This procedure is now bilinear in both \+ arguments. The infix form is available e.g., e1 &c e2. This procedur e works in Clifford algebras in dimensions up to and including 9. Mul tiplication of matrices with entries in a Clifford algebra can be done with a procedure 'rmulm' described below." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 128 "This procedure requires thir d argument of type name or a numeric multiple of a name. Then it compu tes Clifford product in Cl(K)." }}{PARA 258 "" 0 "" {TEXT -1 221 "\nTh is version can take index as a way of passing a parameter. The index \+ could be of type `&*`(numeric,\{name,symbol,array,matrix\}) or of type \{name,symbol,array,matrix\}.\n\nWhen the bilinear form B is symboli c, use cmulRS." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 264 55 "Typical use: cmulNUM(e1,e3we4,B); cmulNUM(e1,e3we4,-K); " }{TEXT 265 3 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2255 "cmulNUM:= proc(a1,a2,lname) \n local L,N,L2,x,x1,x2,S,i,ii,T1,T2,K,p1,p2,coB,na meB,a12;global B:\n options `Copyright (c) 1995-2005 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\n description `Last \+ revised: September 17, 2005`;\n####################################### ######\n###This is additional code for Maple 6 version:\n############# ################################\nif hastype(\{a1,a2\},cliprod) then\n a12:=map(Cliplus:-clieval,[a1,a2]);\n return Cliplus:-cliexpand(c libilinear(a12[1],a12[2],procname,lname))\nend if: \n################# ##################################################################### \n### old name cmul2B: this procedure computes recursively Clifford pr oduct of any two #\n### cliscalars, clibasmons, climons, and clipolyno ms in Clifford algebras Cl(lname) #\n################################ ######################################################\n if nargs<>3 \+ then error \"exactly three arguments are needed\" end if:\n if has(0, map(simplify,[a1,a2])) then return 0 end if;\n if a2=`Id` then return a1 end if:\n if a1=`Id` then return a2 end if:\n L:=Clifford:-extra ct(a1,'integers');\n N:=nops(L):\n ################\n ##### The fol lowing 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 typ e(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 unexpecte d type\"\n end if;\n ################\n if N=0 then return coeff(a1 ,Id)*a2\n elif N=1 then\n L2:=Clifford:-extract(a2,'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:=substring (a1,4..5);\n p2:=procname(x2,a2,lname):\n S:=clibilinear(x1,p2,p rocname,lname);\n return simplify(S-coB*nameB[op(L)]*a2)\n end if; \n x:=cat(e,L[-1]);\n p1:=substring(a1,1..(3*N-4));\n p2:=procname( x,a2,lname):\n S:=clibilinear(p1,p2,procname,lname)\n -add((-1)^ (i)*coB*nameB[L[-i],L[-1]]*\nprocname(makeclibasmon(subs(L[-i]=NULL,L[ 1..-2])),a2,lname),i=2..N); \n return reorder(simplify(S))\nend proc: \n" }}{PARA 0 "" 0 "" {TEXT 266 19 "No. 27. Procedure " }{TEXT 310 6 "cmulRS" }{TEXT 311 114 " computes Clifford product using Rota-Stein c liffordization technique. It can accept now -K in place of the name.\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4904 "cmulRS:=proc(a1,a2,lname)\nlo cal max_grade,L1,N1,L2,N2,genPS,fun1,fun2,srt,cup,pList1,PN1,\n p List2,PN2,pSgn1,pSgn2,a,i,j,m,n,res,pos1,pos2,F1,F2,coB,nameB,a12;\nop tions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fause r. All rights reserved.`;\ndescription `Last revised: September 17, 20 05`;\n#############################################\n###This is additi onal code for Maple 6 version:\n###################################### #######\nif hastype(\{a1,a2\},cliprod) then\n a12:=map(Cliplus:-clie val,[a1,a2]);\n return Cliplus:-cliexpand(clibilinear(a12[1],a12[2], procname,lname))\nend if: \n########################################## ################################################\n### This procedure c omputes Clifford product of any two cliscalars, clibasmons, climons, # \n### and clipolynoms in Clifford algebras Cl(lname) using Rota-Sten c liffordization #\n### Procedure cmulRS modified by Rafal to acce pt -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,arr ay,matrix\})) then\n coB:=op(select(type,\{op(lname)\},numeric)); \n nameB:=op(select(type,\{op(lname)\},name));\n else\n error \"third argument is of unexpected type\"\n end if;\n ############## ##\n L1:=Clifford:-extract(a1,'integers');\n N1:=nops(L1);\n L2:=Cl ifford:-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..N 2)))\n end if;\n if N2=1 then \n return reorder(simplify(makeclib asmon([op(L1),L2[1]])\n +add((-1)^(i-1)*coB*nameB[L1[-i],L2[1]]*mak eclibasmon(subs(L1[-i]=NULL,L1)),i=1..N1)))\n end if;\n#### genPS ; g enerate a power set of 1..N, option remember\n genPS:=proc(N)\n lo cal a,i,plst;\n option remember; \n a:=[seq(i,i=1..N)]:\n pls t:=[a]:\n for i in a do\n plst:=[op(subs(i=NULL,plst)),op(plst )]:\n end do:\n end proc:\n#### prepare combinatorics for L1:\n f un1:=proc(a1) a1 end proc:\n for i from 1 to N1 do\n fun1(i):=L1[i ];\n end do:\n#### here is the old code for the poweset \n# a:=[seq( i,i=1..N1)]:\n# pList1:=[a]:\n# for i in a do\n# pList1 := [op(su bs(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 fo r L2:\n fun2:=proc(a2) a2 end proc:\n for i from 1 to N2 do\n fun 2(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# pList2 := [op(subs(i = NULL,pList2)), op(pList2)]:\n# end do:\n####\npList2 :=genPS(N2);\n PN2:=nops(pList2)+1; ## added 1 here\n pList2:=sort( pList2,(a,b)->evalb(nops(a)<=nops(b)));\n pSgn2:=[seq((-1)^(add(pList 2[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 loca l i;\n if nops(lst1)<>nops(lst2) then return 0 end if;\n if lst1 =[] then return 1 end if;\n if nops(lst1)=1 then return coB*nameB[l st1[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 wh ich are potentially non zero in the cup(..) tangle #\n################ ###################################################################\n \+ max_grade:=nops(\{op(L1),op(L2)\}); ## <== new code\n res:=0:\n po s1:=0:\n for j from 0 to N1 do # for all j-vectors of pList1\n F1:= N1!/((N1-j)!*j!);\n pos2:=0:\n for i from 0 to min(N2,max_grade-j) d o # for all i-vectors of pList2\n \+ # which do not exceed max_grade (others are zero)\n F2:=N2!/((N 2-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(fu n1,pList1[PN1-pos1-n]),map(fun2,pList2[pos2+m]),coB,nameB)*\n \+ makeclibasmon([op(map(fun1,pList1[pos1+n])),op(map(fun2,pList2[PN2-pos 2-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 cm ulRS 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 559 "cmulgen:=proc() global _default_ Clifford_product,_warnings_flag;\noptions `Copyright (c) 1995-2005 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: September 17, 2005`;\n############################ #################\nif _default_Clifford_product <> 'cmulgen' then\n \+ return _default_Clifford_product(args)\nelse \n if _warnings_flag th en\n WARNING(\"to assign Clifford product, execute 'useproduct' with argument cmulRS, cmulNUM, or cmul_user_defined first\");\n end if; \n return 'cmulgen'(args);\n end if; \nend proc:\n" }}{PARA 0 "" 0 " " {TEXT 268 25 "No. 29. Wrapper function " }{TEXT 314 4 "cmul" }{TEXT 315 90 " for the Clifford product given by cmulNUM, cmulRS, or other p rocedure such as 'cmulgen'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1380 " cmul:=proc() local lname;\noptions `Copyright (c) 1995-2005 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: September 17, 2005`;\n################################### ##########\n if type(op(procname),procedure) then\n lname:=`B`;\n \+ else\n lname:=op(procname);\n end if;\n if member(0,[args]) the n return 0 end if;\n if nargs <=1 then return args end if;\n if narg s = 2 then\n########################################################## \n### Speed-wise it makes no difference whether cmulgen or #\n### _def ault_Clifford_product is used in the following. # ################### #######################################\n return clicollect(clibiline ar(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 \+ makes no difference whether cmulgen or #\n### _default_Clifford_produc t is used in the following. # ####################################### ###################\nif not type(_default_Clifford_product,procedure) \+ then \n error \"global variable _default_Clifford_product must be as signed a procedure so that 'cmul' could proceed beyond this point. Sor ry. For help see ?cmul.\" \nend if;\n return procname(clibilinear( eval(args[1]),eval(args[2]),cmulgen,lname),args[3..-1]); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 270 29 "No. 30: Ampersand version of " }{TEXT 316 4 "cmul" }{TEXT 317 226 ". This version of `&c` correctl y uses -K for index. When K has been assigned a matrix, use\n&c[''K''] (e1,e2) and &c[''-K''](e1,e2). Otherwise, use &c[K](e1,e2), &c[-K](e1, e2), or &c(e1,e2). (Has been moved to Clifford:-setup).\n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 2306 "`&m`:=proc() local NP,ARGS,coB,nameB,lname ,decindex,flagdec;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: September 17, 2005`;\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 fla gdec:=false:\n end if;\nelse lname:=op(procname);\n ARGS:=[args] ;\n if type(lname,`&*`(numeric,name)) then\n coB:=op(selec t(type,\{op(lname)\},numeric));\n nameB:=op(select(type,\{op(l name)\},name));\n else\n coB:=1:\n nameB:=lname:\n end if;\n flagdec:=false:\n end if;\n####################### ################\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif \+ type([args],listlist) then\n if type(op(args),function) then\n \+ ARGS:=op(op(args));\n coB:=1:\n nameB:=eval(op(0,op(args))); \n if type(nameB,`&*`(numeric,name)) then\n coB:=op(selec t(type,\{op(nameB)\},numeric));\n nameB:=op(select(type,\{op(n ameB)\},name));\n end if;\n elif type(op(args),`&*`(numeric,fu nction)) then\n nameB:=\{op(op(args))\}:\n coB:=op(select(ty pe,nameB,numeric));\n nameB:=op(select(type,nameB,function));\n \+ ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n error \+ \"unable to determine index or wrong index, use name in double quotes \+ as in &c[''B''] or &c[''-B'']\"\n end if;\nelif\n type([args],lis t) then\n ARGS:=args;\n coB:=1:\n nameB:=`B`; #default name \nel se\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) \+ then return 0 end if;\nif NP <=1 then return op(ARGS) end if;\nreturn \+ cmul[eval(lname)](op(ARGS)); \nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 271 18 "No. 31. Procedure " }{TEXT 318 10 "useproduct" }{TEXT 319 80 " that allows user to select which procedure is used to compute Cliffor d product." }{TEXT 478 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1259 "u seproduct:=proc(name::\{symbol,name\})\nlocal wstr;\nglobal _default_C lifford_product; #,cmulgen;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: September 17, 2005`;\n################################# ############\n######################################################## ###########\n###This procedure uses global variable _default_Clifford_ product #\n########################################################## ######### \nif not member(name,\{cmulRS,cmulNUM,cmulgen,cmul_user_defi ned\}) then \n WARNING(\"expecting one of the following Clifford pr oducts: cmulRS, cmulNUM, cmulgen, or cmul_user_defined\") \nend if;\ni f member(name,\{cmul_user_defined\}) and not type(name,procedure) then \n WARNING(\"no computations with cmul can be peformed yet since cmu l_user_defined has not been defined as procedure. Select cmulRS, cmulN UM, or a new procedure as argument to useproduct.\");\n _default_Cli fford_product:=name;\nreturn NULL;\nend if;\n######################### #######\n_default_Clifford_product:=name; #change value of _default_Cl ifford_product \n################################\nwstr:=cat(\"cmul wi ll 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 'cmu l' and '&c'. It gives the Clifford multiplication in the Clifford alg ebra of the quadratic form Q related to the symmetric part g of B as Q (x) = g(x, x) = B(x, x) where B = g + A (A is the alternating part of \+ B). Like 'cmul', it works now in all dimensions 1 through 9. Via the procedure 'rmulm' described below in (32), this multiplication can al so be applied to matrices with entries in a Clifford algebra.\n\nThis \+ procedure can now accept an optional index which could be K or -K. " } }{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 78 "Prop osed by Yvon Siret, Universite Joseph Fourier , Grenoble, France. Tha nks!" }}{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 1425 "cmulQ:=proc() local ii,N,L,m,Sxy,symbxy,lna me,coB,nameB;global B:\noptions `Copyright (c) 1995-2005 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n###################################### #######\n####################################\nif type(op(procname),pr ocedure) then\n lname:=`B`;\nelse\n lname:=op(procname);\nend if ;\n####################################\nif member(0,[args]) then retu rn 0 end if;\n####################################\nSxy:=map(op,map(cl iterms,\{args\}));\nSxy:=map(op,map(Clifford:-extract,Sxy,'integers')) ;\nsymbxy:=remove(type,Sxy,posint);\nif symbxy <> \{\} then \n retur n cmul[lname](args) \nend if;\nm:=max(op(Sxy),1);# 1 is needed when bo th x and y have maxindex=0\nif type(evalm(lname),matrix) then \n N:= linalg[coldim](evalm(lname)):\n if m>N then \n error \"input co ntains 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 377 "scalar part:=proc(a::\{cliscalar,clibasmon,climon,clipolynom\}) local a1,p; \+ \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: September 17 , 2005`;\n#############################################\na1:=simplify( a):\nif type(a1,cliscalar) then return a1 end if;\np:=clicollect(a1): \nreturn coeff(p,Id);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "N o. 35. Procedure " }{TEXT 325 10 "vectorpart" }{TEXT -1 353 " computes the k-vector part of the given Clifford polynomial u where k is a non negative integer. For example, vectorpart(e1 + 3*e2we3, 2) = 3*e2we3. \+ When k = 0 then the procedure returns the scalar part of u times 'Id' , e.g., vectorpart(2*Id + 3*e2we3, 0) = 2*Id. Note that vectorpart(2* Id + e1we2, 0) 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 593 "vectorpart:=proc(a::\{cliscalar,clibasmon,climon,cli polynom\},a2::nonnegint) \nlocal a1,p,K;\noptions `Copyright (c) 1995- 2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: July 19, 2004`;\n######################## #####################\na1:=expand(simplify(a)): #expand is needed\nif \+ maxgrade(a1) < a2 then return 0 end if;\n K:=proc() if maxgrade(args [1])=a2 then true else false end if end proc:\nif type(a1,`+`) then p: =select(K,a1) elif\n maxgrade(a1)<>a2 then p:=NULL else \n p:=a1 \+ \nend if;\nif p=NULL then return 0 else return p end if;\nend proc:\n " }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 36. Procedure " }{TEXT 326 4 "c exp" }{TEXT -1 236 " computes Clifford exponential of a Clifford numbe r in Cl(B) up to the order specified by the second argument which is \+ a nonnegative integer n. It n = 0 then this procedure returns 'Id'. It can accept another argument such as B or -B. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 185 "Typical use: cexp(e1we 2*t, 3);cexp(e1we2*t, 3,K);\n cexp((e1 + e1we2)*t, 4); cexp((e1 + e1we2)*t, 4,-K); \n cexp(e1we2, 3) ; cexp(e1 + e1we2, 4,K);\n" }}{PARA 258 "> " 0 "" {MPLTEXT 1 0 1361 "c exp:=proc(p::\{numeric,cliscalar,clibasmon,climon,clipolynom\},N::nonn egint) \nlocal pp,k,ans,ans1,ans2,lname,coB,nameB;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\ndescription `Last revised: September 17, 2005`;\n########## ###################################\nif nargs=2 then\n coB:=1:\n \+ nameB:=`B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3 ],\{name,symbol,matrix,array\}) then\n coB:=1:\n nameB:=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 cexp. See ?cexp for more help.\" \n end if;\nelse \n error \"two or three arguments expected in cexp. See ?cexp for mo re help.\"\nend if;\n################################\nk:='k':\nif typ e(p,\{numeric,cliscalar\}) then return (add(p^k/k!,k=0..N)) end if;\ni f evalb(vectorpart(p,0)=p) then \n pp:=scalarpart(p);\n return ((a dd(pp^k/k!,k=0..N)*Id)) \nend if;\npp:=clisort(displayid(p)):\nif N=0 \+ then return Id \n elif N=1 then return Id+pp; \n else \n ans 1:=cexp(pp,N-1,lname);\n ans2:=cexp(pp,N-2,lname);\n ans:= ans1+cmul[lname](((ans1-ans2)*(N-1)!),pp)/N!;\n return ans;\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 37. Procedure \+ " }{TEXT 327 5 "cexpQ" }{TEXT -1 257 " computes Clifford exponential o f a Clifford number in Cl(Q) up to the order specified by the second \+ argument which is a nonnegative integer n. It n = 0 then this procedur e returns 'Id'. This procedure can also accept an optional argument s uch as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 " " {TEXT -1 210 "Typical use: cexpQ(e1we2*t, 3); or cexpQ((e1 + 2*e1we2 )*t, 4);\n cexpQ(e1we2*t, 3,K); or cexpQ((e1 + 2*e 1we2)*t, 4,K);\n cexpQ(Id+2*e1we3,4); or cexpQ(e1 \+ + 2*e1we2, 4,-K);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1375 "cexpQ:=pro c(p::\{numeric,cliscalar,clibasmon,climon,clipolynom\},N::nonnegint) \+ \nlocal pp,k,ans,ans1,ans2,lname,coB,nameB;\noptions `Copyright (c) 19 95-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: September 17, 2005`;\n################# ############################\nif nargs=2 then\n coB:=1:\n nameB: =`B`: \n lname:=`B`: \nelif nargs=3 then\n if type(args[3],\{nam e,symbol,matrix,array\}) then\n coB:=1:\n nameB:=args[3]; \n lname:=args[3];\n elif type(args[3],`&*`(numeric,\{name,sy mbol,matrix,array\})) then\n coB:=op(select(type,\{op(args[3])\} ,numeric));\n nameB:=op(remove(type,\{op(args[3])\},numeric));\n lname:=args[3]:\n else \n error \"wrong type of third \+ argument in cexpQ. See ?cexpQ for more 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(p p^k/k!,k=0..N)*Id \nend if;\npp:=clisort(displayid(p)):\nif N=0 then r eturn 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 a ns:=ans1+cmulQ[lname](((ans1-ans2)*(N-1)!),pp)/N!;\n return an s;\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 38. Pro cedure " }{TEXT 328 4 "wexp" }{TEXT -1 168 " computes exterior exponen tial of a Clifford number u up to the order specified by the second a rgument which is a nonnegative integer n. It returns 'Id' when n = 0. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 38 "Typical use: wexp(e1we2 + e3we4, 5); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 612 "wexp:= proc(p::\{cliscalar,clibasmon,climon,clipolyn om\},N::nonnegative) \nlocal pp,power,cu,i;\noptions `Copyright (c) 19 95-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved. `;\ndescription `Last revised: September 17, 2005`;\n################# ############################\n if nargs<>2 then error \"two parameter s are needed in 'wexp'\" end if;\n pp:=expand(p);\n if N=0 then retu rn 1 elif\n N=1 then return 1+clisort(pp) end if;\n power:=pp;\n \+ cu:=1+pp;\n for i from 2 to N do\n power:=wedge(power,pp);\n \+ cu:=cu + power/i!;\n end do;\n return subs(Id=1,clicollect(clisort( cu)));\n end proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 39. Proced ure " }{TEXT 329 9 "reversion" }{TEXT -1 411 " calculates reversion in the Clifford algebra. It is linear in its argument and it is always a Clifford algebra anti-automorphism. 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 exterior algebra. This procedure can now take a thi rd 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 2641 "reversion :=proc(a1::\{cliscalar,clibasmon,climon,clipolynom,matrix\}) \n \+ local ind,expr,wtp,ptw,lname,flagindexed;\n global _scal artypes,B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: Se ptember 17, 2005`;\n#############################################\nif \+ hastype([args[1]],cliprod) then \n error \"in order to handle 'type/ cliprod', load in package Cliplus\" \n end if;\n###################### ######\nif type(a1,cliscalar) then 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,`&*`(algeb raic,name)\}) then\n lname:=args[2];\n flagindexed:=true:\nelse \+ error \"only one or two arguments are expected\"\nend if;\n########### #################\n### Auxiliary function that converts wedges to Clif ford products: wedge ->> Clifford product\n########################### #\nwtp:=proc(a1,lname) local ind,i,arg,rdmon,eq1,ans; global _scalarty pes; \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 me mber(length(a1),\{5,8,11,14,17,20,23,26\}) \n then return a1 \n end if;\nrdmon:=reorder(a1):\nind:=Clifford:-extract(a1,'integers'):\n i:='i':\narg:=[seq(cat(e,op(ind[i])),i=1..nops(ind))];\neq1:=cat(op(ar g))=simplify(eval(cmul[lname](op(arg))));\nif a1=rdmon then ans:=simpl ify(solve(eq1,a1)) \n else ans:=-simplify(solve(-eq1,-rdmon )) \nend if;\nif nops(ind) < 4 then return ans else return wtp(ans, lname) end if;\nend proc:\n############################\n### Auxiliary function that converts Clifford products to wedge: Clifford products \+ ->> wedge\n############################\nptw:=proc(a1,lname) local i,a rg,revarg; global _scalartypes; \nif type(a1,\{`+`,`*`\}) then return \+ (map(ptw,a1,lname)) \n elif type(a1,_scalartypes) then return a1 \n \+ elif type(a1,symbol) and SearchText(e,a1)=0 then return a1 \n elif type(a1,symbol) and length(a1)=2 then return a1 \n elif type(a1,sym bol) and not member(length(a1),\{2,4,6,8,10,12,14,16,18\})\n th en return a1 \n end if;\ni:='i':\narg:=[seq(cat(e,substring(a1,2*i..2* i)),i=1..(length(a1)/2))];\nrevarg:=[seq(arg[nops(arg)-i],i=0..(nops(a rg)-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 conjugation in the Clifford algebra. It is l inear in its argument. Note that 'conjugation' is defined as a compos ition of 'reversion' and 'gradeinv'. Hence, it does not preserve the \+ multivector gradation when the antisymmetric part of B is non-zero. I t can now accept optional argument such as B or -B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 41 "Typical use: conjuga tion(e1 + 4*e2we3); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 825 "conjugation:=proc(a1::algebraic) local lname;gl obal B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bert fried Fauser. All rights reserved.`;\ndescription `Last revised: Septe mber 17, 2005`;\n#############################################\nif nar gs=1 then\n lname:=`B`;\nelif nargs=2 and type(args[2],\n \{sym bol,name,array,matrix,`&*`(numeric,\{symbol,name,array,matrix\})\}) th en\n lname:=args[2];\nelse error \"only one or two arguments are ex pected\"\nend if;\n###########################\nif type(a1,matrix) the n return map(procname,a1,lname) elif\n type(a1,cliscalar) then retur n a1 elif\n type(a1,\{clibasmon,climon,clipolynom\}) then\n r eturn eval(gradeinv(reversion(a1,lname)))\nelse \n error \"wrong inp ut type: input must be of type cliscalar, clibasmon, climon, clipolyno m, or 'matrix'\" \nend if;\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 41. Procedure " }{TEXT 331 8 "c _conjug" }{TEXT -1 72 " calculates complex conjugate in a complexified Clifford algebra; thus, " }}{PARA 258 "" 0 "" {TEXT -1 80 " \+ c_conjug(u) = c_conjug(a + I*b) = a - I*b \+ " }}{PARA 258 "" 0 "" {TEXT -1 140 "where a and b are in the real Clif ford algebra and `I` is the imaginary unit, i.e., I = sqrt(-1). This p rocedure is linear in its argument. " }}{PARA 258 "" 0 "" {TEXT -1 0 " " }}{PARA 258 "" 0 "" {TEXT -1 51 "Typical use: c_conjug((1 + 2*I)*e1 \+ - 3*I*e1we2); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 699 "c_conjug:=pro c(a1::algebraic) local ba,co,terms,t,i;\noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: September 17, 2005`;\n##################### ########################\nif type(a1,matrix) then return map(procname, a1) elif\n type(a1,cliscalar) then return conjugate(a1) elif\n typ e(a1,\{clibasmon,climon,clipolynom\}) then\n t:='t':\n b a:=cliterms(a1);\n co:=[coeffs(a1,ba,'t')];\n terms:=[t] ;i:='i':\n return clisort(add(conjugate(co[i])*terms[i],i=1..no ps(co)))\n else \nerror \"wrong input type: input must be of type cl iscalar, clibasmon, climon, clipolynom, or 'matrix'\" \nend if;\nend p roc:\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 represent ation, or under Lie or automorphism action with respect to an ordered \+ basis specified by the user. The element p is entered as the first ar gument and the basis in the form of a list is specified as the second \+ argument, e.g., buildm(u, basis). It is also possible to specify opti ons 'left', 'right', 'Lie', 'auto', 'false, and 'true'. For example, o ne can find the left-regular representation of the algebra on itself o r, when Cl(B) is simple and isomorphic to a ring of real matrices, one can find matrices representing Clifford polynomials in a real basis o f a minimal ideal. However, there are new procedures below specifical ly designed for finding spinor 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\n buildm(e1, [Id, e1, e2, e1we2]); buildm(e1, [Id, e1, e2, e1we2], 'righ t'); buildm(e1, [Id, e1, e2, e1we2], 'Lie');\nbuildm(e2, [Id, e1, e2, \+ e1we2],'false'); buildm(e1we2+e2, [Id, e1, e2, e1we2], 'true'); buildm (e1, [Id, e1, e2, e1we2], 'Lie','false'); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2969 "buildm:=proc(a1::\{cliscalar,clibasmon,climon,clipo lynom\},\n a2::list(\{cliscalar,clibasmon,climon,clipolyno m\}))\nlocal A,L,N,a11,xm,i,j,Lbasis,neq,vars,sys,sol,nontrivial,a33,f lag;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: Septembe r 17, 2005`;\n#############################################\nflag:=tru e:\nif nargs=2 then a33:='left' end if;\nif nargs=3 then \n if membe r(args[3],\{'true','false'\}) then flag:=args[3];\n \+ a33:='left';\n elif member(args[3],\{'left ','right','Lie','auto'\}) \n the n 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 member(args[3],\{'left','right','Lie','auto'\}) an d member(args[4],\{'false','true'\}) then\n a33:=args[3]; \+ \n flag:=args[4];\n else \n error \"third optional argumen t must be 'left', 'right', 'Lie', 'auto', and the fourth optional argu ment must be 'false' or 'true'\"\n end if;\nend if;\nif nargs>4 then error \"too many arguments. See ?buildm for more help.\" end if;\n### ##############################################\nif flag then \nA:=lina lg[genmatrix](args[2],cbasis(maxindex(args[2])));\nif linalg[rank](A) \+ < nops(args[2]) then \n error \"elements of the list %1 are linearly dependent. Apply 'findbasis' to this list first.\",a2 \nend if;\nend \+ if;\n###local procedure\nnontrivial:=proc(S::\{set(\{relation,algebrai c\}),list(\{relation,algebraic\})\}) \nlocal istrivial;\nprintlevel:=2 :\nistrivial:=proc(x) if type(x,relation) then evalb(x) else evalb(x=0 ) end if end;\nremove(istrivial,S)\nend proc:\n### \nL:=a2:N:=nops(L): xm:=array(1..N,1..N):\nif a33='left' then \n for i from 1 to N do \+ \n eq||i:=clicollect(expand(cmul(a1,L[i])-add(xm[j,i]*L[j],j=1. .N))) \n end do;\nelif a33='right' then \n for i from 1 to N do \+ \n eq||i:=clicollect(expand(cmul(L[i],a1)-add(x m[j,i]*L[j],j=1..N)))\n end do;\nelif a33='Lie' then\n for i fr om 1 to N do\n eq||i:=clicollect(expand(cmul(L[i],a1)-cmul(a1, L[i])-add(xm[j,i]*L[j],j=1..N)))\n end do;\nelif a33='auto' then\n a11:=cinv(a1):\n for i from 1 to N do \n \+ eq||i:=clicollect(expand(cmul(cmul(a1,L[i]),a11)-add(xm[j,i]*L[j], j=1..N)))\n end 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(Lba sis) 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:=n ontrivial(sys): #eliminate trivial equations\nsol:=solve(sys,vars);\ni f sol=NULL then \n error \"no matrix represents %1 in the basis %2 u nder the %3 action\",a1,a2,a33; \nend if;\nassign(sol);\nreturn evalm( xm);\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 43. Procedure \+ " }{TEXT 333 9 "findbasis" }{TEXT -1 680 " finds a basis in a linear v ector space spanned by a set of Clifford polynomials entered as a list . The procedure is used, for example, when finding a basis for a spi nor space S considered as a minimal left or right ideal in Cl(B) gener ated by a primitive idempotent f. To speed up computations, it is advi sable to a standard Clifford basis for Cl(B) in the form of a list of \+ basis monomials as the second argument. If only one list is specified , 'findbasis' determines a suitable Clifford basis itself but it takes twice as much time then since it creates a Clifford basis by using 'c basis(maxindex)' where 'maxindex' is the maximum index found among the elements of the list." }}{PARA 258 "" 0 "" {TEXT -1 69 "\nTypical use : findbasis([2*e1+e2,e2+e1we2,e1we2],[Id,e1,e2,e1we2]);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1479 "findbasis:=proc(a1,a2) local L,clibasis,M ,i,m,r,v,S; \nglobal _prolevel;\noptions `Copyright (c) 1995-2005 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: September 17, 2005`;\n############################# ################\nif evalb(_prolevel=false) then\n if nargs=1 and no t (type(a1,list(\{clibasmon,climon,clipolynom\})) or \n \+ type(a1,set(\{clibasmon,climon,clipolynom\}))) then\nerror \"a rgument of type list/set(\{clibasmon,climon, or clipolynom\}) was expe cted\"\n elif nargs=2 and \n not ((type(a1,list(\{clibasmon,cli mon,clipolynom\})) or \n type(a1, set(\{clibasmon,climon,cl ipolynom\}))) and \n (type(a2,list(clibasmon)) or type(a2,se t(clibasmon)))) or nargs>2 then\nerror \"arguments of type list/set(\{ clibasmon,climon,clipolynom\}) and list/set(clibasmon) were expected\" \nend if;\nend if;\nif nops(a1)=1 then return a1 end if;\n#L:=sort(ma p(displayid,convert(a1,list)),bygrade):\nL:=map(displayid,convert(a1,l ist)): ####NO SORT\nif nargs=2 then clibasis:=sort(convert(a2,list),by grade) else \n clibasis:=sort(convert(`union`(op(map(cliterms,L))),l ist),bygrade);\nend if;\nM:=linalg[genmatrix](L,clibasis);\nr:=linalg[ rank](M):m:=linalg[rowdim](M):\nfor i from 1 to m do v[i]:=linalg[row] (M,i) end do;\nS:=[v[1]]:\nfor i from 2 to m while nops(S) < r do \n \+ if linalg[rank](linalg[stackmatrix](op(S),v[i]))=nops(S)+1 \n \+ then S:=[op(S),v[i]] \n end if\nend do;\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 for 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 o f 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 sort a list L by grade one may use sort(L, bygrade) where 'bygr ade' is a new procedure in this package described below. The output f rom the procedure 'cbasis' is already sorted that way." }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 392 "The second argu ment 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 stored under clidata()[5] to generate the real basis and it returns the stored list clidata()[5] as the second list in its ouput. If f does not equal clidata()[4] then complete computations are performed but they may take longer. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 129 "It is assumed that the numerical value s of B have been specified.\n\nThe procedure returns a list consisting of two ordered lists: " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 91 "(1) the first list contains the real basis o f S written as expanded Clifford polynomials; " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 106 "(2) the second list co ntains basis monomials from the standard basis in Cl(B) which generate the " }}{PARA 258 "" 0 "" {TEXT -1 108 " first list by m ultiplying f on the left or on the right depending whether S=Cl(B)f \+ or S=fCl(B). " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 " " {TEXT 257 260 "There is a one-to-one correspodence between the two o rdered lists.\n\nTypical use: minimalideal([Id,e1,e2,e3,e1we2,e1we3,e2 we3,e1we2we3],(1/2)*(Id+e3),'left');\n minimali deal([Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3],(1/2)*(Id+e3),'right'); \n" }{MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2248 "minimali deal:=proc(a1,a2,a3) \nlocal L,gens,m,flag1,f,flag_left,data,SB,g,SBge ns,pq,p,q,l,ni,realdim,dimoverK,cb,N,bel; \nglobal B,_shortcut_in_mini malideal,_prolevel;\noptions `Copyright (c) 1995-2005 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: September 17, 2005`;\n######################################### ####\nif not type(B,diagmatrix) then \n error \"bilinear form B has \+ not been assigned a matrix or is not diagonal\" \nend if; \nif not _pr olevel then\n if not type(a1,list(\{clibasmon,climon,clipolynom\})) \+ then\n error \"first argument must of type list(\{clibasmon,c limon,clipolynom\})\" \n elif not type(a2,'primitiveidemp') then \+ \n error \"second argument must be a primitive idempoten t\" \n elif not member(a3,\{'left','right',\"left\",\"right \"\}) then\n error \"third argument must be 'left', or 'right'\" \n end if;\n end if;\nf:=displayid(eval(a2)):\nif member (a3,\{'left',\"left\"\}) then flag_left:=true else flag_left:=false en d if;\ng:='g':\nL:=sort(a1,bygrade):\nif _shortcut_in_minimalideal the n\n m:=maxindex(L):\n flag1:=evalb(L=cbasis(m)): \n if flag1 th en\n data:=clidata():\n if eval(eval(data[4]))=eval(f) or ev al(eval(data[4]))=gradeinv(f) then\n SBgens:=data[5]:\n \+ if flag_left then SB:=[seq(cmulQ(g,f),g=SBgens)] else \n \+ SB:=[seq(cmulQ(f,g),g=SBgens)] \n end if;\n \+ return [SB,SBgens,a3];\n end if;\n end if;\nend if; \n#I f can't use the shortcut, perform necessary computations.\npq:=Bsignat ure():\np:=pq[1]:q:=pq[2]:\nl:=floor((p+q)/2);ni:=2^(l-1);\nif member( (p-q) mod 8,\{0,1,2\}) then \n realdim:=2*ni; \n dimoverK:=2 *ni; \nelif member((p-q) mod 8,\{3,7\}) then \n realdim:=4*ni; \n dimoverK:=2*ni; \nelse\n realdim:=4*ni; \n dimoverK:=n i \nend if;\ngens:=clidata()[5]: #put elements from clidata()[5] first in L\nL:=remove(member,L,gens):\nL:=[op(gens),op(L)]:\nSB:=[f]:SBgens :=[Id]:cb:=remove(member,L,[Id]); \nfor g in cb while nops(SB) < reald im do\n N:=nops(SB):\n if flag_left then bel:=cmulQ(g,f) else be l:=cmulQ(f,g) end if; \n SB:=findbasis([op(SB),bel]); \n if nop s(SB)>N then SBgens:=[op(SBgens),g] end if;\nend do:\nreturn [SB,SBgen s,a3];\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 48. Procedu re " }{TEXT 335 6 "Kfield" }{TEXT -1 340 " computes a basis for a fiel d K. The field K is the field of the spinor space S = Cl(B)f or S = f Cl(B) of the given Clifford algebra Cl(B). It is isomorphic to the r eals, 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 defined, the first argument of the procedure is expected to be th e same as the output from the procedure 'minimalideal'. The second ar gument is the idempotent f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 225 "The procedure eliminates from the list of basis elements in the real ideal space nilpotent elements and leav es only those whose square modulo f is either +1 or -1. It returns th ose elements as the first list in its output. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 200 "If the primitive idemp otent f is the same as the one stored under clidata()[4] and if the g enerators of the real basis in the minimal ideal S match those stored \+ under clidata()[5], then the procedure" }}{PARA 258 "" 0 "" {TEXT -1 99 "uses generators of K stored under clidata()[6] and returns them a s 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 c ontains generators (Clifford basis monomials) of the elements in the f irst list. Elements of the two lists are in one-to-one relationship. \+ " }}{PARA 258 "" 0 "" {TEXT -1 204 "\nTypical use: dim:=2:B:=linalg[d iag](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 4634 "Kfield:=proc(a1::list(\{list,string,symbol\}),a2::clipolynom) \n local SB,gens,f,ff,k,n,fg,f_from_data,field,flag3,side,expr,i,ijk,g,di men,Kbasis,Kgens,Kdim,data,T4: \nglobal B,_shortcut_in_Kfield,_proleve l;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September \+ 17, 2005`;\n#############################################\n#### Local \+ procedure needed only in 'Kfield' ###\nT4:=proc() \nlocal gens,Kbasis, f,mi,clibas,clibas2,x,y,z; global B;\nKbasis:=args[1];f:=Kbasis[1];mi: =max(op(map(maxindex,Kbasis)));\nclibas:=subsop(1=NULL,cbasis(mi));\ni f type(B,matrix) then gens:=subsop(1=NULL,clidata()[6]);\n \+ clibas:=remove(member,clibas,gens):\n cli bas:=[op(gens),op(clibas)];\nend if;\nclibas2:=[]:\nfor x in clibas do \n if evalb(cmul(x,x) = -Id) then clibas2:=[op(clibas2),x] end if; \nend do:\nfor x in clibas2 do \nfor y in remove(member,clibas2,[x]) \+ do\nfor z in remove(member,clibas2,[x,y]) do\n if member(cmul(x,f ),\{Kbasis[2],-Kbasis[2]\}) then \n if member(cmul(y,f),\{Kbas is[3],-Kbasis[3]\}) then\n if member(cmul(z,f),\{Kbasis[4], -Kbasis[4]\}) then \n if type([x,y,z],'purequatbasis') t hen return [x,y,z]\n end if;\n end if;\n end if;\n end if;\nend do ;\nend do;\nend do;\nend proc:\n###################################### ########\nif not _prolevel then\n if not type(a2,'primitiveidemp') t hen \n error \"second argument must be a primitive idempotent\"\n end if;\nend if;\n##############################################\nS B:=a1[1]:gens:=a1[2]:side:=a1[3]:f:=eval(a2):i:='i':g:='g':\n######### #####################################\nif not member(f,SB) then \n e rror \"idempotent entered %1 is not a member of the first list\",f \ne nd if;\n###new line here instead of >>>not assigned(B)<<<\nif not type (B,matrix) then \n error \"matrix must be assigned to B\" \nend if; \nif side='right' then flag3:=true else flag3:=false end if;\ndata:=cl idata():\nfield:=data[1]:\nif field = 'real' then return [[f],[Id]] \n elif 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 Kgen s:=data[6];\nif flag3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2..nops(K gens))]\n else Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2..nops(Kgens ))] \nend if;\nreturn ([Kbasis,Kgens]) \nend if;\nend if;\n########### ######################################################\n#Do this when \+ shortcut can't be used when field = 'complex'\n####################### ##########################################\nKdim:=2:\nKbasis:=[f]:Kgen s:=[Id]:\nn:=nops(gens):\nfor i from 1 to n while nops(Kbasis) < Kdim \+ do\n if cmul(gens[i],gens[i])=-Id then\n expr:=cmul(f,gen s[i],f);\n if expr<>0 then Kbasis:=[op(Kbasis),SB[i]];\n \+ Kgens:=[op(Kgens),gens[i]] \n end if; \n end if:\nend do;\nreturn [Kbasis,Kgens];\n###################### #########################################\nelif field = 'quaternionic' then \n dimen:=linalg[coldim](B):\n if dimen=2 then Kbasis:=[ op(SB)];\n Kgens:=[op(gens)];\n \+ return [Kbasis,Kgens]\n elif member(dimen,\{3,4,5,6,7,8,9\}) the n\n if _shortcut_in_Kfield then\n f_from_data:=e val(eval(data[4])):\n fg:=gradeinv(f): \n i f member(f_from_data,\{f,-f,fg,-fg\}) and gens=data[5] then \+ Kgens:=data[6];\nif f lag3 then Kbasis:=[f,seq(cmul(Kgens[i],f),i=2..nops(Kgens))]\n \+ else \n Kbasis:=[f,seq(cmul(f,Kgens[i]),i=2 ..nops(Kgens))] \nend if;\nreturn [Kbasis,Kgens] \nend if;\nend if;\ne nd if;\n############################################################## ##\n#Do this when shortcut can't be used and field = 'quaternionic'\n# ###############################################################\nKdim: =4:\nKbasis:=[f]:Kgens:=[Id]:\nn:=nops(gens):\nfor i from 1 to n while nops(Kbasis) < Kdim do\n if cmul(gens[i],gens[i])=-Id then\n \+ expr:=cmul(f,gens[i],f);\n if expr<>0 then Kbasis:=[op(K basis),SB[i]];\n Kgens:=[op(Kgens),gens[i]] \+ \n end if;\n end if:\nend do;\n########################## ##\n ijk:=T4(Kbasis);\n############################\n Kgens:=[ Id,op(ijk)]:\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]\nelse error \"wrong name of the field. See ?Kfield for more hel p.\" \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 46. Procedure " }{TEXT 336 12 "spinorKbasis" }{TEXT -1 263 " finds a spin or 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 t o whether (p-q) mod 8 is 0, 1, 2, or 3, 7, or 4, 5, 6, respective ly (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 ord ered list SBgens containing generators of a real basis in a minimal id eal Cl(B)f or fCl(B) (it doesn't matter whether the ideal was left or \+ right). These generators are found by the procedure 'minimalideal' an d are returned by it as a second list." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 104 "The second argument is the prim itive idempotent f used to generate the minimal ideal Cl(B)f or fCl( B)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 150 "The third argument is a list FBgens of generators that generate t he field K; these generators are returned as a second list by the proc edure 'Kfield'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 " " {TEXT -1 143 "The fourth argument is either 'left' or 'right' depend ing whether we deal with the left minimal ideal Cl(B)f or the right mi nimal ideal Cl(B)f." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 434 "If the first three arguments in the input match res pectively clidata()[5], clidata()[4], and clidata()[6] in that order , i.e., SBgens=clidata()[5], f=clidata()[4], and FBgens=clidata()[6] , then the procedure finds previously computed generators of S over K \+ which are stored as clidata()[7]. These generators are then used to c ompute the K-basis for S=Cl(B)f or S=fCl(B) depending whether the four th argument is 'left' or 'right'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" } }{PARA 258 "" 0 "" {TEXT -1 47 "The procedure returns a list of three \+ elements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 163 "(1) the first list is an ordered list of Clifford polyno mials which give a basis in Cl(B)f or fCl(B) (depending on what was t he fourth argument in the procedure);" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 178 "(2) the second list is an ordered list of generators over f which give the elements in the first list. \+ There is a one-to-one correspodence between the elements of the two l ists." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 254 "(3) the third element in the output is either 'left' or 'right' a nd it matches the fourth argument in the input to the procedure. That element is to remind the user that the basis returned as the first li st 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 \+ spinorKbasis(SBgens,f,FBgens,'left')\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2866 "spinorKbasis:=\nproc(a1::list,a2::\{clibasmon,climo n,clipolynom\},a3::list,a4::\{string,symbol\}) \nlocal flag,flag_left, Kdim,f,SBgens,SB,FBgens,g,SBKbasis,SBKgens,data,i,poss,m,p; \nglobal B ,_shortcut_in_spinorKbasis,_prolevel;\noptions `Copyright (c) 1995-200 5 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: September 17, 2005`;\n####################### ######################\nif not type(B,matrix) then \n error \"matrix must be assigned to B\" \nend if;\nif not _prolevel then\n if not t ype(a2,'idempotent') then \n error \"second argument must be an i dempotent\" elif\n not member(a4,\{'left','right',\"left\",\"right\" \}) then \n error \"the fourth argument must be 'left', or 'right '\"\n end if;\nend if;\nSBgens:=a1:f:=eval(a2):FBgens:=a3:\nif SBgen s=FBgens then return [[f],[Id],a4] end if;\nif a4='left' or a4=\"left \" then flag_left:=true else flag_left:=false end if;\ndata:=clidata() :\nif _shortcut_in_spinorKbasis then\n if eval(f)=eval(data[4]) a nd SBgens=data[5] and FBgens=data[6] then\n SBKgens:=data[7];\n \+ SBKbasis:=[]:\n g:='g':\n if flag_left then SBKbasis:=[s eq(cmulQ(g,f),g=SBKgens)]\n else SBKbasis:=[seq(cmul Q(f,g),g=SBKgens)]\n end if; \n return [SBKbasis,SBKgens, a4];\n end if;\nend if; \nKdim:=nops(FBgens):SB:=[]:\ng:='g':\nif f lag_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,a 4] end if;\nm:=max(op(map(maxindex,SBgens)));\nposs:=cbasis(m);\nSBKge ns:=[Id]:\ng:='g':\nif flag_left then SB:=remove(member,SB,[seq(cmul(f ,g),g=FBgens)])\n else SB:=remove(member,SB,[seq(cmul(g,f) ,g=FBgens)])\nend if;\nposs:=remove(member,poss,FBgens);\nfor g in pos s while nops(SB)>0 do\n if flag_left then \n for i from 1 to \+ Kdim do p[i]:=cmul(g,f,FBgens[i]) end do;\n else \n for i fro m 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]) the n\n SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2]]):\n \+ SBKgens:=[op(SBKgens),g]\n end if:\n else\n if (flag[1, 1] or flag[2,1]) and \n (flag[1,2] or flag[2,2]) and\n \+ (flag[1,3] or flag[2,3]) and\n (flag[1,4] or flag[2,4])\n \+ then\n SB:=remove(member,SB,[p[1],-p[1],p[2],-p[2],p[3],-p[3 ],p[4],-p[4]]):\n SBKgens:=[op(SBKgens),g]\n end if:\n \+ end if;\n if flag[1,1] then SBKbasis:=[op(SBKbasis),p[1]] else\n \+ SBKbasis:=[op(SBKbasis),-p[1]] \n end if;\n \+ end do;\ng:='g':\nif flag_left then SBKbasis:=[seq(cmul(g,f),g=SBKgens )] else\n SBKbasis:=[seq(cmul(f,g),g=SBKgens)]\nend i f;\nreturn [SBKbasis,SBKgens,a4]\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 47. Procedure " }{TEXT 337 10 "squaremodf" }{TEXT -1 390 " computes the square of a basis element u in a left or right mini mal ideal Cl(B)f or fCl(B) entered as the first argument modulo a pri mitive idempotent f entered as the second argument. The procedure do esn't check whether f is primitive or not. Thus, the procedure return s 1 or -1 depending whether cmul(u,u) = f or cmul(u,u) = -f. The pro cedure returns 0 if u is a nilpotent element." }}{PARA 258 "" 0 "" {TEXT -1 115 "\nThis procedure is needed to identify/verify squares of the basis elements in the field K of the spinor ideal S. \n" }} {PARA 258 "" 0 "" {TEXT -1 54 "Typical use: squaremodf((1/2)*(Id+e1),( 1/2)*(Id+e1);\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 785 "squaremodf:=pr oc(a1::\{clibasmon,climon,clipolynom\},a2::idempotent) \nlocal p;globa l B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: Septembe r 17, 2005`;\n#############################################\nif nargs< >2 then \n error \"two arguments needed of type clibasmon, or climon , or clipolynom, and 'idempotent'\" \nend if;\nif a1=a2 then return 1 \+ elif\n not type(B,matrix) then error \"matrix must be assigned to B \" \nend if;\np:=cmul(a1,a1):\nif expand(p-a2)=0 then return 1 elif\n \+ expand(p+a2)=0 then return -1 elif\n (p=0 or type(a1,nilpotent)) t hen 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 proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 48 . Procedure " }{TEXT 338 8 "RHnumber" }{TEXT -1 76 " gives the Radon-H urwitz number for any integer.\n\nTypical use: RHnumber(2);\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 506 "RHnumber:=proc(a1::integer)\noptio ns `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: September 17, 2005` ;\n#############################################\nif member(a1,\{0,1,2 \}) then return a1 elif\n a1=3 then return 2 elif\n member(a1,\{4, 5,6,7\}) then return 3 elif\n a1>=8 then return RHnumber(a1-8)+4 eli f\n a1<0 then return RHnumber(a1+8)-4 else\n error \"wrong value o f 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 a bout the orthogonal Clifford algebra Cl(Q) of the given bilinear form \+ B (assumed to have been diagonalized). The procedure must be called w ith B, or with a signature of B given as a list [p,q], or simply as cl idata() (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 elements:" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 187 "(a) the first entry is the string 'real', ' complex', or 'quaternionic' depending whether the spinor representatio n of Cl(Q) is over the field K of the reals, complexes, or quaternion s;\n" }}{PARA 258 "" 0 "" {TEXT -1 305 "(b) the second entry is the di mension of the spinor representation over the field K;\n\n(c) the thir d entry is 'simple' or 'semisimple' depending on the structure of the \+ algebra;\n\n(d) the fourth entry is a primitive idempotent f which m ay be used to generate a left or right minimal ideal in the algebra. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 574 " NOTE: the idempotents are stored here in an unevaluated form so that t hey could be easily recognized as Clifford products of simpler project ion 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 entry is a list of basis monomials ordered by grade \+ which give a basis for K (this is in terms of these monomials that mat rices representing Clifford polynomials will be written by the procedu re '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 calle d as 'clidata()' then it returns information about the Clifford algebr a of the currently defined bilinear form B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 81 "Typical use: clidata(); clidata([2,3]); clidata(B);clidata(linalg[diag](1,1,1));\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 475 "clidata:=proc() local a1,clidata2;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n#############################################\nif nargs=0 then a1:=`B` else a1:=args end if:\nif not type(a1,\{list(nonnegint), matrix\}) then\n WARNING(\"to find out about Clifford algebra Cl_\{p ,q\} try clidata([p,q]) or 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 read in when needed by the procedure 'clidata'. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "clidata2" }{TEXT -1 0 "" } {MPLTEXT 1 0 16602 ":=proc(a1::\{list(nonnegint),matrix\})\nlocal SBge ns,FBgens,SBKgens,p,q,l,ni,K,dimoverK,dimoverR,numfact,struct,primidem p;\nglobal B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz an d Bertfried Fauser. All rights reserved.`,remember;\ndescription `Last revised: September 17, 2005`;\n###################################### #######\n#K = field of spinor repesentation, it is R, C, or H dependin g on [p,q]\n#dimoverK = dimension of spinor representation over the fi eld K\n#dimoverR = dimension of spinor representation over the reals R \n#numfact = number of idempotent factors in any primitive idempotent \n#SBgens = basis monomials generating Cl(Q)f and fCl(Q) over R\n#FBge ns = basis monomials providing a basis for K\n#SBKgens = basis monomia ls generating Cl(Q)f and fCl(Q) over K \n#p = number of +1 in the diag onal form Q of B\n#q = number of -1 in the diagonal form Q of B\n#stru ct = structure of Cl(Q) is 'simple' or 'semisimple'\n#primidemp = prim itive idempotent f to generate Cl(B)f or fCl(B)\nif nargs=0 then\n###n ew line instead of >>>not assigned(B)<<<\nif not type(B,matrix) then \+ \n error \"matrix must be assigned to B\" else\n return clidata (B)\nend if;\nend if; \nif type(args[1],list(nonnegint)) then p:=args[ 1][1]:q:=args[1][2]: \n elif type(args[1],matrix) then \n p:= Bsignature(args)[1]; q:=Bsignature(args)[2] \n else \n error \+ \"wrong argument types in 'clidata'\" \n end if;\nif type(args[1],li st(nonnegint)) and (p>9 or q>9) then\n error \"p and q must satisfy \+ 0 <= p,q <= 9\" \nend if;\nl:=floor((p+q)/2);ni:=2^(l-1);\nif member(( p-q) mod 8,\{0,1,2\}) then \n K:='real'; dimoverR:=2*ni; dimoverK :=2*ni; \nelif member((p-q) mod 8,\{3,7\}) then \n K:='complex'; \+ dimoverR:=2*2*ni; dimoverK:=2*ni; else\n K:='quaternionic'; dimov erR:=4*ni; dimoverK:=ni \nend if;\nnumfact:=q-RHnumber(q-p);\nif modp( (p-q) = 1,4) then struct:='semisimple' \n else struct:='simple' \nen d if;\nprimidemp:=table():SBgens:=table():FBgens:=table():SBKgens:=tab le():\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];\nS BKgens[[2,0]]:=SBgens[[2,0]];\n\nprimidemp[[2,2]]:=\n''cmulQ''((1/2)*( Id+e1we3),(1/2)*(Id+e2we4));\nSBgens[[2,2]]:=[Id,e1,e2,e1we2];\nFBgens [[2,2]]:=[Id];\nSBKgens[[2,2]]:=SBgens[[2,2]];\n\nprimidemp[[3,1]]:=\n ''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e3we4));\nSBgens[[3,1]]:=[Id,e2,e3,e 2we3];\nFBgens[[3,1]]:=[Id];\nSBKgens[[3,1]]:=SBgens[[3,1]];\n\nprimid emp[[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,e1we3,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,e2we3we4];\nFBgens[[4,2]]:=[Id];\nSBKgens[[4,2 ]]:=SBgens[[4,2]];\n\nprimidemp[[4,4]]:=\n''cmulQ''((1/2)*(Id+e1we5),( 1/2)*(Id+e2we6),(1/2)*(Id+e3we7),(1/2)*(Id+e4we8));\nSBgens[[4,4]]:=[I d,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,e3we4,e3we5,e4we5,e2we3we4,\ne2we3we5,e2we4 we5,e3we4we5,e2we3we4we5];\nFBgens[[5,3]]:=[Id];\nSBKgens[[5,3]]:=SBge ns[[5,3]];\n\nprimidemp[[8,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2 we3we4we5),(1/2)*(Id+e4we5we6we7),\n (1/2)*(Id+e2we4we6we8)); \nSBgens[[8,0]]:=[Id,e2,e3,e4,e5,e6,e7,e8,e2we3,e2we4,e2we5,e2we6,e2we 7,\ne2we8,e3we8,e2we3we8];\nFBgens[[8,0]]:=[Id];\nSBKgens[[8,0]]:=SBge ns[[8,0]];\n\nprimidemp[[1,7]]:=\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)* (Id+e4we5we6),(1/2)*(Id+e2we5we7),\n (1/2)*(Id+e1we8));\nSBge ns[[1,7]]:=[Id,e1,e2,e3,e4,e5,e6,e7,e1we2,e1we3,e1we4,e1we5,e1we6,\ne1 we7,e2we6,e1we2we6];\nFBgens[[1,7]]:=[Id];\nSBKgens[[1,7]]:=SBgens[[1, 7]];\n\nprimidemp[[0,8]]:=\n''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3 we4we5),(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,e6 we8,e7we8];\nFBgens[[0,8]]:=[Id];\nSBKgens[[0,8]]:=SBgens[[0,8]];\n\n# Complex, simple (15 cases)\nprimidemp[[0,1]]:=Id; #complex numbers\nS Bgens[[0,1]]:=[Id,e1];\nFBgens[[0,1]]:=[Id,e1];\nSBKgens[[0,1]]:=[Id,e 1];\n\nprimidemp[[1,2]]:=(1/2)*(Id+e1we3);\nSBgens[[1,2]]:=[Id,e1,e2,e 1we2];\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''cmu lQ''((1/2)*(Id+e1we2we3),(1/2)*(Id+e3we4we5));\nSBgens[[0,5]]:=[Id,e1, e2,e3,e4,e5,e1we4,e1we5];\nFBgens[[0,5]]:=[Id,e3];\nSBKgens[[0,5]]:=[I d,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];\nSBKgens[[2,3]]:=[Id,e1,e2,e1we2];\n\nprim idemp[[4,1]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e4we5));\nSBgens[[4, 1]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\nFBgens[[4,1]]:=[Id,e2w e3];\nSBKgens[[4,1]]:=[Id,e2,e4,e2we4];\n\nprimidemp[[1,6]]:=\n''cmulQ ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e4we5we6),(1/2)*(Id+e1we7));\nSBgens[ [1,6]]:=[Id,e1,e2,e3,e4,e5,e6,e1we2,e1we3,e1we4,e1we5,e1we6,e2we5, \+ e2we6,e1we2we5,e1we2we6]; \+ \nFBgens[[1,6]]:=[Id,e4];\nSBKgens[[1,6]]:=[Id,e1,e2,e5,e1we2,e1we5,e2 we5,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,e 1we3,e1we4,e2we3,e2we4,e3we4,\n e1we2we3,e1we2we4,e1we3 we4,e2we3we4,e1we2we3we4]; \nFBgens[[3,4]]:=[Id,e4];\nSBKgens[[3,4]]:= [Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\n\nprimidemp[[5,2]]:=\n''cmu lQ''((1/2)*(Id+e1),(1/2)*(Id+e4we6),(1/2)*(Id+e5we7));\nSBgens[[5,2]]: =[Id,e2,e3,e4,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5,\n \+ e2we3we4,e2we3we5,e2we4we5,e3we4we5,e2we3we4we5]; \nFBgens[[5,2]]:=[I d,e2we3];\nSBKgens[[5,2]]:=[Id,e2,e4,e5,e2we4,e2we5,e4we5,e2we4we5];\n \nprimidemp[[7,0]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),( 1/2)*(Id+e4we5we6we7));\nSBgens[[7,0]]:=[Id,e2,e3,e4,e5,e6,e7,e2we3,e2 we4,e2we5,e2we6,e2we7,\n e4we6,e4we7,e2we4we6,e2we4we7] ; \nFBgens[[7,0]]:=[Id,e2we3];\nSBKgens[[7,0]]:=[Id,e2,e4,e6,e2we4,e2w e6,e4we6,e2we4we6];\n\nprimidemp[[0,9]]:=\n''cmulQ''((1/2)*(Id+e1we2we 3),(1/2)*(Id+e3we4we5),(1/2)*(Id+e1we4we6),\n (1/2)*(Id+e3we6 we7));\nSBgens[[0,9]]:=\n[Id,e1,e2,e3,e4,e5,e6,e7,e8,e9,e1we8,e1we9,e2 we8,e2we9,e3we8,e3we9,\n e4we8,e4we9,e5we8,e5we9,e6we8,e6we9,e7we8,e7w e9,e8we9,e1we8we9,\n e2we8we9,e3we8we9,e4we8we9,e5we8we9,e6we8we9,e7we 8we9];\nFBgens[[0,9]]:=[Id,e8we9];\nSBKgens[[0,9]]:=[Id,e1,e2,e3,e4,e5 ,e6,e7,e8,e1we8,e2we8,e3we8,e4we8,\n e5we8,e6we8,e7we8 ];\n\nprimidemp[[2,7]]:=\n''cmulQ''((1/2)*(Id+e3we4we5),(1/2)*(Id+e5we 6we7),(1/2)*(Id+e1we8),\n (1/2)*(Id+e2we9));\nSBgens[[2,7]]:= \n[Id,e1,e2,e3,e4,e5,e6,e7,e1we2,e1we3,e1we4,e1we5,e1we6,e1we7,e2we3, \n e2we4,e2we5,e2we6,e2we7,e3we6,e3we7,e1we2we3,e1we2we4,e1we2we5,\n e 1we2we6,e1we2we7,e1we3we6,e1we3we7,e2we3we6,e2we3we7,e1we2we3we6,\n e1 we2we3we7];\nFBgens[[2,7]]:=[Id,e5];\nSBKgens[[2,7]]:=\n[Id,e1,e2,e3,e 6,e1we2,e1we3,e1we6,e2we3,e2we6,e3we6,e1we2we3,e1we2we6,e1we3we6,\n e2 we3we6,e1we2we3we6];\n\nprimidemp[[4,5]]:=\n''cmulQ''((1/2)*(Id+e1we6) ,(1/2)*(Id+e2we7),(1/2)*(Id+e3we8),(1/2)*(Id+e4we9));\nSBgens[[4,5]]:= \n[Id,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4,e1we5,e2we3,e2we4,e2we5,e3we4, \n e3we5,e4we5,e1we2we3,e1we2we4,e1we2we5,e1we3we4,e1we3we5,e1we4we5, \n e2we3we4,e2we3we5,e2we4we5,e3we4we5,e1we2we3we4,e1we2we3we5,\n e1we 2we4we5,e1we3we4we5,e2we3we4we5,e1we2we3we4we5];\nFBgens[[4,5]]:=[Id,e 5];\nSBKgens[[4,5]]:=\n[Id,e1,e2,e3,e4,e1we2,e1we3,e1we4,e2we3,e2we4,e 3we4,e1we2we3,e1we2we4,\n e1we3we4,e2we3we4,e1we2we3we4];\n\nprimidemp [[6,3]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e4we7),(1/2)*(Id+e5we8),( 1/2)*(Id+e6we9));\nSBgens[[6,3]]:=\n[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2w e5,e2we6,e3we4,e3we5,e3we6,e4we5,\n e4we6,e5we6,e2we3we4,e2we3we5,e2we 3we6,e2we4we5,e2we4we6,e2we5we6,\n e3we4we5,e3we4we6,e3we5we6,e4we5we6 ,e2we3we4we5,e2we3we4we6,\n e2we3we5we6,e2we4we5we6,e3we4we5we6,e2we3w e4we5we6];\nFBgens[[6,3]]:=[Id,e2we3];\nSBKgens[[6,3]]:=\n[Id,e2,e4,e5 ,e6,e2we4,e2we5,e2we6,e4we5,e4we6,e5we6,e2we4we5,e2we4we6,\n e2we5we6, e4we5we6,e2we4we5we6];\n\nprimidemp[[8,1]]:=\n''cmulQ''((1/2)*(Id+e1), (1/2)*(Id+e2we3we4we5),(1/2)*(Id+e4we5we6we7),\n (1/2)*(Id+e8 we9));\nSBgens[[8,1]]:=\n[Id,e2,e3,e4,e5,e6,e7,e8,e2we3,e2we4,e2we5,e2 we6,e2we7,e2we8,e3we8,\n e4we6,e4we7,e4we8,e5we8,e6we8,e7we8,e2we3we8, e2we4we6,e2we4we7,\n e2we4we8,e2we5we8,e2we6we8,e2we7we8,e4we6we8,e4we 7we8,e2we4we6we8,\n e2we4we7we8];\nFBgens[[8,1]]:=[Id,e2we3];\nSBKgens [[8,1]]:=\n[Id,e2,e4,e6,e8,e2we4,e2we6,e2we8,e4we6,e4we8,e6we8,e2we4we 6,e2we4we8,\n e2we6we8,e4we6we8,e2we4we6we8];\n\n#Quaternionic, simple (12 cases)\nprimidemp[[0,2]]:=Id; #quaternions\nSBgens[[0,2]]:=[Id,e1 ,e2,e1we2];\nFBgens[[0,2]]:=[Id,e1,e2,e1we2];\nSBKgens[[0,2]]:=[Id];\n \nprimidemp[[0,4]]:=(1/2)*(Id+e1we2we3);\nSBgens[[0,4]]:=[Id,e1,e2,e3, e4,e1we4,e2we4,e3we4];\nFBgens[[0,4]]:=[Id,e1,e1we3,e3];\nSBKgens[[0,4 ]]:=[Id,e4];\n\nprimidemp[[1,3]]:=(1/2)*(Id+e1we4);\nSBgens[[1,3]]:=[I d,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\nFBgens[[1,3]]:=[Id,e2,e3,e2we 3];\nSBKgens[[1,3]]:=[Id,e1];\n\nprimidemp[[4,0]]:=(1/2)*(Id+e1);\nSBg ens[[4,0]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\nFBgens[[4,0]]:= [Id,e2we3,e2we4,e3we4];\nSBKgens[[4,0]]:=[Id,e2];\n\nprimidemp[[1,5]]: =\n''cmulQ''((1/2)*(Id+e2we3we4),(1/2)*(Id+e1we6));\nSBgens[[1,5]]:=[I d,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4,e1we5,e2we5,e3we5,\n \+ e4we5,e1we2we5,e1we3we5,e1we4we5];\nFBgens[[1,5]]:=[Id,e2,e2we4,e4]; \nSBKgens[[1,5]]:=[Id,e1,e5,e1we5];\n\nprimidemp[[2,4]]:=\n''cmulQ''(( 1/2)*(Id+e1we5),(1/2)*(Id+e2we6));\nSBgens[[2,4]]:=[Id,e1,e2,e3,e4,e1w e2,e1we3,e1we4,e2we3,e2we4,e3we4,\n e1we2we3,e1we2we4,e 1we3we4,e2we3we4,e1we2we3we4];\nFBgens[[2,4]]:=[Id,e3,e4,e3we4];\nSBKg ens[[2,4]]:=[Id,e1,e2,e1we2];\n\nprimidemp[[5,1]]:=\n''cmulQ''((1/2)*( Id+e1),(1/2)*(Id+e5we6));\nSBgens[[5,1]]:=[Id,e2,e3,e4,e5,e2we3,e2we4, e2we5,e3we4,e3we5,e4we5,\n e2we3we4,e2we3we5,e2we4we5,e 3we4we5,e2we3we4we5];\nFBgens[[5,1]]:=[Id,e2we3,e2we4,e3we4];\nSBKgens [[5,1]]:=[Id,e2,e5,e2we5];\n\nprimidemp[[6,0]]:=\n''cmulQ''((1/2)*(Id+ e1),(1/2)*(Id+e2we3we4we5));\nSBgens[[6,0]]:=[Id,e2,e3,e4,e5,e6,e2we3, e2we4,e2we5,e2we6,e3we6,e4we6,\n e5we6,e2we3we6,e2we4we 6,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+e2we8));\nSBgens[[2,6]]:=\n[Id,e1,e2,e3,e4 ,e5,e6,e1we2,e1we3,e1we4,e1we5,e1we6,e2we3,e2we4,e2we5,\n e2we6,e3we6, e4we6,e5we6,e1we2we3,e1we2we4,e1we2we5,e1we2we6,e1we3we6,\n e1we4we6,e 1we5we6,e2we3we6,e2we4we6,e2we5we6,e1we2we3we6,e1we2we4we6,\n e1we2we5 we6];\nFBgens[[2,6]]:=[Id,e3,e3we5,e5];\nSBKgens[[2,6]]:=[Id,e1,e2,e6, e1we2,e1we6,e2we6,e1we2we6];\n\nprimidemp[[3,5]]:=\n''cmulQ''((1/2)*(I d+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,e 4we5,e1we2we3,e1we2we4,e1we2we5,e1we3we4,e1we3we5,e1we4we5,\n e2we3we4 ,e2we3we5,e2we4we5,e3we4we5,e1we2we3we4,e1we2we3we5,\n e1we2we4we5,e1w e3we4we5,e2we3we4we5,e1we2we3we4we5];\nFBgens[[3,5]]:=[Id,e4,e5,e4we5] ;\nSBKgens[[3,5]]:=[Id,e1,e2,e3,e1we2,e1we3,e2we3,e1we2we3];\n\nprimid emp[[6,2]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e5we7),(1/2)*(Id+e6we8 ));\nSBgens[[6,2]]:=\n[Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we4 ,e3we5,e3we6,e4we5,\n e4we6,e5we6,e2we3we4,e2we3we5,e2we3we6,e2we4we5, e2we4we6,e2we5we6,\n e3we4we5,e3we4we6,e3we5we6,e4we5we6,e2we3we4we5,e 2we3we4we6,\n e2we3we5we6,e2we4we5we6,e3we4we5we6,e2we3we4we5we6];\nFB gens[[6,2]]:=[Id,e2we3,e2we4,e3we4];\nSBKgens[[6,2]]:=[Id,e2,e5,e6,e2w e5,e2we6,e5we6,e2we5we6];\n\nprimidemp[[7,1]]:=\n''cmulQ''((1/2)*(Id+e 1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e7we8));\nSBgens[[7,1]]:=\n[Id,e2, e3,e4,e5,e6,e7,e2we3,e2we4,e2we5,e2we6,e2we7,e3we6,e3we7,e4we6,\n e4we 7,e5we6,e5we7,e6we7,e2we3we6,e2we3we7,e2we4we6,e2we4we7,e2we5we6,\n e2 we5we7,e2we6we7,e3we6we7,e4we6we7,e5we6we7,e2we3we6we7,e2we4we6we7,\n \+ e2we5we6we7];\nFBgens[[7,1]]:=[Id,e2we3,e3we5,e2we5];\nSBKgens[[7,1]]: =[Id,e2,e6,e7,e2we6,e2we7,e6we7,e2we6we7];\n\n#Real, semi-simple (8 ca ses)\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)*(Id+e2we3));\nSBgens[[2,1]]:=[Id,e2];\nFBg ens[[2,1]]:=[Id];\nSBKgens[[2,1]]:=SBgens[[2,1]];\n\nprimidemp[[3,2]]: =\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we4),(1/2)*(Id+e3we5));\nSBgens [[3,2]]:=[Id,e2,e3,e2we3];\nFBgens[[3,2]]:=[Id];\nSBKgens[[3,2]]:=SBge ns[[3,2]];\n\nprimidemp[[0,7]]:= ''cmulQ''((1/2)*(Id+e1we2we3),(1/2)*( Id+e3we4we5),(1/2)*(Id+e1we4we6),\n (1/2)*(Id+e3we6we7));\nSB gens[[0,7]]:=[Id,e1,e2,e3,e4,e5,e6,e7];\nFBgens[[0,7]]:=[Id];\nSBKgens [[0,7]]:=SBgens[[0,7]];\n\nprimidemp[[4,3]]:=\n''cmulQ''((1/2)*(Id+e1) ,(1/2)*(Id+e2we5),(1/2)*(Id+e3we6),\n (1/2)*(Id+e4we7));\nSBg ens[[4,3]]:=[Id,e2,e3,e4,e2we3,e2we4,e3we4,e2we3we4];\nFBgens[[4,3]]:= [Id];\nSBKgens[[4,3]]:=SBgens[[4,3]];\n\nprimidemp[[9,0]]:=\n''cmulQ'' ((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5),1/2*(Id+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];\n FBgens[[9,0]]:=[Id];\nSBKgens[[9,0]]:=SBgens[[9,0]];\n\nprimidemp[[5,4 ]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we6),(1/2)*(Id+e3we7),\n \+ (1/2)*(Id+e4we8),(1/2)*(Id+e5we9));\nSBgens[[5,4]]:=[Id,e2,e3,e4 ,e5,e2we3,e2we4,e2we5,e3we4,e3we5,e4we5,e2we3we4, e2we3we5,e2we4we5,e3 we4we5,e2we3we4we5];\nFBgens[[5,4]]:=[Id];\nSBKgens[[5,4]]:=SBgens[[5, 4]];\n\nprimidemp[[1,8]]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4 we5),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,e2we 4,e2we5,e2we6,e2we7,e2we8,e2we9];\nFBgens[[1,8]]:=[Id];\nSBKgens[[1,8] ]:=SBgens[[1,8]];\n\n#Complex, semi-simple - none\n\n#Quaternionic, se mi-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];\nSBKgens[[1,4]]:=[Id,e1];\n\nprimidemp[[5,0] ]:=\n''cmulQ''((1/2)*(Id+e1),(1/2)*(Id+e2we3we4we5));\nSBgens[[5,0]]:= [Id,e2,e3,e4,e5,e2we3,e2we4,e2we5];\nFBgens[[5,0]]:=[Id,e2we3,e3we5,e2 we5];\nSBKgens[[5,0]]:=[Id,e2];\n\nprimidemp[[2,5]]:=\n''cmulQ''((1/2) *(Id+e3we4we5),(1/2)*(Id+e1we6),(1/2)*(Id+e2we7));\nSBgens[[2,5]]:=[Id ,e1,e2,e3,e4,e5,e1we2,e1we3,e1we4,e1we5,\n e2we3,e2we4, e2we5,e1we2we3,e1we2we4,e1we2we5];\nFBgens[[2,5]]:=[Id,e3,e3we5,e5];\n SBKgens[[2,5]]:=[Id,e1,e2,e1we2];\n\nprimidemp[[6,1]]:=\n''cmulQ''((1/ 2)*(Id+e1),(1/2)*(Id+e2we3we4we5),(1/2)*(Id+e6we7));\nSBgens[[6,1]]:=[ Id,e2,e3,e4,e5,e6,e2we3,e2we4,e2we5,e2we6,e3we6,\n e4w e6,e5we6,e2we3we6,e2we4we6,e2we5we6];\nFBgens[[6,1]]:=[Id,e2we3,e3we5, e2we5];\nSBKgens[[6,1]]:=[Id,e2,e6,e2we6];\n\nprimidemp[[7,2]]:=''cmul Q''((1/2)*(Id+e1),(1/2)*(Id+e2we8),\n (1/2)*( Id+e3we9),(1/2)*(Id+e4we5we6we7));\nSBgens[[7,2]]:=[Id,e2,e3,e4,e5,e6, e7,e2we3,e2we4,e2we5,e2we6,e2we7,\ne3we4,e3we5,e3we6,e3we7,e4we5,e4we6 ,e4we7,e2we3we4,e2we3we5,e2we3we6,\ne2we3we7,e2we4we5,e2we4we6,e2we4we 7,e3we4we5,e3we4we6,e3we4we7,\ne2we3we4we5,e2we3we4we6,e2we3we4we7];\n FBgens[[7,2]]:=[Id,e4we5,e5we7,e4we7];\nSBKgens[[7,2]]:=[Id,e2,e3,e4,e 2we3,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+e6we7we8w e9));\nSBgens[[3,6]]:=[Id,e2,e3,e6,e7,e8,e9,e2we3,e2we6,e2we7,e2we8,e2 we9,e3we6,e3we7,\ne3we8,e3we9,e6we7,e6we8,e6we9,e2we3we6,e2we3we7,e2we 3we8,e2we3we9,e2we6we7,\ne2we6we8,e2we6we9,e3we6we7,e3we6we8,e3we6we9, e2we3we6we7,e2we3we6we8,\ne2we3we6we9];\nFBgens[[3,6]]:=[Id,e6we7,e7we 9,e6we9];\nSBKgens[[3,6]]:=[Id,e2,e3,e6,e2we3,e2we6,e3we6,e2we3we6];\n \nreturn ([K,dimoverK,struct,primidemp[[p,q]],\n SBgens[[p,q]], FBgens[[p,q]],SBKgens[[p,q]]]);\nend proc:\n##################\nreturn clidata2(a1); #### <<< Return from 'clidata'\nend 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 or three integers depending on whether B is \+ non-degenerate or degenerate, that is, L=[p,q] or L=[p,q,d]. Here d = \+ dim(rad B), and p (q) denotes number of +1 (-1) in the diagonal form o f B." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 42 "Typical use: Bsignature(); Bsignature(B);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1291 "Bsignature:=proc() local curB,Bdiag,pos,neg,deg,i,L ;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: Se ptember 17, 2005`;\n#############################################\nif \+ nargs=0 then\n if not type(B,matrix) then\n error \"square ma tric should be assigned to B first\"\n else curB:=B \n end if;\n elif nargs=1 then\n if not type(evalm(args[1]),matrix) then\n \+ error \"argument entered is not a matrix\"\n else curB:=evalm(args [1]) \n end if;\nelse error \"wrong number of arguments. See ?Bsig nature for more help.\" \nend if;\nBdiag:=diagonalize(evalm(curB-(curB -linalg[transpose](curB))/2));\nif not type(Bdiag,diagmatrix) then \n \+ error \"unable to diagonalize symmetric part of the input\"\nend if; \nL:=map(signum,[seq(Bdiag[i,i],i=1..linalg[coldim](Bdiag))]):\nif not type(L,list(integer)) then\n error \"unable to determine signs of e xpressions %1\",L\nend if;\npos:=0:neg:=0:deg:=0:\nfor i from 1 to lin alg[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 \"un able 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,n eg,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 fie ld K of the reals, complexes, or quaternions when Cl(Q) is simple.\nTh e procedure " }{TEXT 341 11 "spinorKrepr" }{TEXT -1 183 " finds matrix representation of any Clifford polynomial in a minimal left or right \+ ideal in Cl(Q) generated by a primitive idempotent f. The procedure i s 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 g enerators of the minimal ideal S considered as a K-vector space. For \+ standard f equal to clidata()[4] these generators are stored under cli data()[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 ba sis elements spanning K. For standard f equal to clidata()[4] these g enerators are stored under clidata()[5]. Matrices computed by 'spinor Krepr' will be expressed in terms of these basis elements of K;" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 111 "(4) \+ the fourth argument is a one of the strings 'left' or 'right' dependin g whether the ideal is left or right." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 562 "When standard input is used, i.e. , the second argument equals clidata()[7] and the third argument equal s clidata()[5], the procedure tries to use previously computed matrice s representing 1-vectors. These matrices are stored as .m files with \+ the names 'matrealL.m', 'matcompL.m', 'matquatL.m' for real, complex, \+ and quaternionic matrices in the left-regular spinor representation. I f the first argument entered belongs to Cl(Q) whose 1-vector matrices \+ have been previously computed, the procedure calls 'matKrepr' which ma kes use of these pre-computed matrices." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 470 "Typical use: dim:=4:B:=linalg[d iag](1,-1,-1,-1):clibasis:=cbasis(dim):data:=clidata():\n \+ f:=data[4]:\n sbasis:=minimalideal (clibasis,f,'left');\n fbasis:=Kfield(sbasis,f );\n Kbasis:=spinorKbasis(sbasis[2],f,fbasis[2 ],'left');\n spinorKrepr(e1,Kbasis[1],fbasis[2] ,'left');\n spinorKrepr(2*e1+Id-3*e1we2we3,Kbas is[1],fbasis[2],'left');\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5600 "spi norKrepr:=proc(a1::\{clibasmon,climon,clipolynom,numeric\},\n \+ a2::list(\{clibasmon,climon,clipolynom\}),\n \+ a3::list(\{clibasmon,climon,clipolynom\}),\n a4::\{s tring,symbol\})\nlocal i,j,k,reprdim,r,a,FBgens,eq,hbasis,g,terms,sys, vars,sol,M,pqsig,pq,\n flag_left,data,Kbasis,f,v,pqmod8,n,expr,fl ag_simple;\nglobal B,_prolevel,_shortcut_in_spinorKrepr,matrealL,matre alR,matcompL,matcompR,matquatL,matquatR;\noptions `Copyright (c) 1995- 2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: September 17, 2005`;\n################### ##########################\nif not type(B,diagmatrix) then \n error \+ \"bilinear form B must be defined as diagonal matrix\" \nelse pq:=Bsig nature() \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) the n\n error \"maximum index %1 found in input is greater than the size %2 of the current bilinear form B\", maxindex(a1),linalg[coldim](B) \+ \nend if;\n##################################\nhbasis:=a2:FBgens:=a3:r eprdim:=nops(hbasis):n:=nops(FBgens):\n############################### ###\nif member(a4,\{'left',\"left\"\}) then flag_left:=true elif\n m ember(a4,\{'right',\"right\"\}) then flag_left:=false else\n error \+ \"last argument expected to be 'left' or 'right' but received %1 inste ad\",a4\nend if; \n################################################### #####################\n#This procedure gives faithful representations \+ when Cl(p,q) is simple\n#and unfaithful when Cl(p,q) is semi-simple. I n order to get faithful\n#representations in this last case, use 'matK repr' or use this procedure\n#as shown in examples.\n################# #######################################################\n#if flag_simp le then\nif a1=Id then return linalg[diag](1$reprdim) elif\n a1=-Id then return linalg[diag](-1$reprdim) elif\n type(a1,numeric) then r eturn linalg[diag](a1$reprdim) \nend if;\n############################ ############################################\n#when _shortcut_in_spino rKrepr is false, 'matKrepr' is not used\n############################# ###########################################\nif _shortcut_in_spinorKre pr 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 eli f member(pqmod8,\{0,1,2\}) and not flag_left then\n #if not assig ned(matrealR) then readlib(matrealR) end if;\n pqsig:=map(op,[in dices(matrealR)]) \n elif member(pqmod8,\{3,7\}) and flag_left then \+ \n #if not assigned(matcompL) then readlib(matcompL) end if;\n \+ pqsig:=map(op,[indices(matcompL)]) \n elif member(pqmod8,\{3,7\} ) and not flag_left then\n #if not assigned(matcompR) then readli b(matcompR) end if;\n pqsig:=map(op,[indices(matcompR)]) \n el if member(pqmod8,\{4,5,6\}) and flag_left then \n #if not assigne d(matquatL) then readlib(matquatL) end if;\n pqsig:=map(op,[indi ces(matquatL)]) \n elif member(pqmod8,\{4,5,6\}) and not flag_left t hen\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 dat a:=clidata(pq):f:=eval(eval(data[4])):\n g:='g': \n if \+ flag_left then Kbasis:=[seq(cmulQ(g,f),g=data[7])] \n \+ else Kbasis:=[seq(cmulQ(f,g),g=data[7])] \n end if; \n if hbasis=Kbasis then\n if FBgens=data[6] then return matKrepr(a 1,a4) end if; \n end if;\n end if;\nend if;\n############## #######################\n#Continue finding the matrix\n############### ######################\na:='a':j:='j':k:='k':\nif flag_left then\n e xpr:=add(add(a[j,k]*cmulQ(hbasis[j],FBgens[k]),j=1..reprdim),k=1..n); \n for j from 1 to reprdim do r[j]:=add(a[j,k] * FBgens[k],k=1..n) e nd do; \n for i from 1 to reprdim do\n eq:=expand(cmulQ(a1,h basis[i])-expr);\n terms:=cliterms(eq);\n eq:=clicollect(e q,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 i f sol=NULL then \nerror \"unable to find matrix due input error: check if the last argument matches the one previously used in 'spinorKbasis '\"\n end if; \n v[i]:=convert([seq(subs(sol,r[j]),j=1..re prdim)],vector);\n end do:\nM:=linalg[transpose](linalg[stackmatrix] (seq(eval(v[i]),i=1..reprdim)));\nreturn subs(Id=1,evalm(M));\nelse \+ \n expr:=add(add(a[j,k]*cmulQ(FBgens[k],hbasis[j]),j=1..reprdim),k =1..n);\n for j from 1 to reprdim do r[j]:=add(a[j,k] * FBgens[k],k= 1..n) end do; \n for i from 1 to reprdim do \n eq:=exp and(cmulQ(hbasis[i],a1)-expr);\n terms:=cliterms(eq);\n eq :=clicollect(eq,terms);\n sys:=\{coeffs(eq,terms)\}:\n var s:=\{seq(seq(a[j,k],k=1..n),j=1..reprdim)\};\n sol:=solve(sys,va rs);\n if sol=NULL then \nerror \"unable to find matrix due to 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:\n####################### #####################################################\n#The next line \+ produces wrong results in some quat right cases:\n#M:=linalg[transpose ](linalg[stackmatrix](seq(eval(v[i]),i=1..reprdim)));\n############### #############################################################\nM:=lina lg[stackmatrix](seq(eval(v[i]),i=1..reprdim));\nreturn subs(Id=1,evalm (M));\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. 52. \+ Procedure " }{TEXT 342 5 "rmulm" }{TEXT -1 110 " extends the followi ng multiplications to matrix entries: cmul, cmulQ, wedge, omul, `&r`, \+ `&*`\n " }}{PARA 258 "" 0 "" {TEXT -1 271 "In this last \+ case, the commutative multiplication `*` is applied to the matrix ent ries. It takes three arguments or four arguments. If the fourth argum ent is used, it is either of type name/symbol/array/matrix or a numeri c multiple of such type, for example, K or -K. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 90 "To apply Clifford multi plication 'cmul[B]' to matrix entries enter one of the following: " } }{PARA 258 "" 0 "" {TEXT -1 143 "rmulm(M1, M2, cmul); rmulm(M1,M2,cmul ,B);rmulm(M1,M2,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]' to matrix entries ente r one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 235 "rmulm(M1, M 2, cmulQ); rmulm(M1,M2,cmulQ,B);rmulm(M1,M2,cmulQ,K);rmulm(M1,M2,cmulQ ,-K);\n&cQm(M1, M2); &cQm[B](M1,M2);&cQm[K](M1,M2);&cQm[-K](M1,M2); \+ \n\nTo apply wedge multiplication 'wedge' to matrix entries enter one \+ of the following:" }}{PARA 258 "" 0 "" {TEXT -1 60 "rmulm(M1, M2, `&w` ); M1 &wm M2; rmulm(M1, M2, wedge); " }}{PARA 258 "" 0 "" {TEXT -1 113 "\nTo apply some generic possibly non-commutative multiplicatio n `&r` to matrix entries enter one of the following:" }}{PARA 258 "" 0 "" {TEXT -1 37 "rmulm(M1, M2, `&r`); M1 &rm M2; " }}{PARA 258 " " 0 "" {TEXT -1 98 "\nTo apply standard commutative scalar multiplicat ion to matrix entries enter one of the following:" }}{PARA 258 "" 0 " " {TEXT -1 39 "rmulm(M1, M2, `&*`); M1 &* M2; " }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 70 "Similarly for ma trices with quaternionic entries we have as follows: " }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 89 "To apply quatern ionic multiplication 'qmul' to matrix entries enter one of the followi ng:" }}{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, [I d + e1we2, e2 + e3, e1 - e2, Id + e2we3]); " }}{PARA 258 "" 0 "" {TEXT -1 137 "M2 := linalg[matrix](2, 2, [Id + e2we3, e3 + e4, e1 - e2 , Id + e1we3]); \n\nM1 := linalg[matrix](2, 2, [Id + 2*qi + 3*qj, qi, qi + qj]); " }}{PARA 258 "" 0 "" {TEXT -1 58 "M2 := linalg[matrix](2 , 2, [Id + qi, qj, qk, Id - qi]); \n" }}{PARA 258 "> " 0 "" {MPLTEXT 1 0 7272 "rmulm:=proc(a1::\{list(matrix),dfmatrix,matrix,clipolynom,cl iscalar,clibasmon,climon\},\n a2::\{list(matrix),dfmatrix,m atrix,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,out;\nglobal _prolevel, ` &r`;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: Septembe r 17, 2005`;\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 nargs=4 then\n if ty pe(eval(args[4]),\{name,symbol,matrix,array\}) then\n coB:=1:\n \+ nameB:=args[4];\n lname:=args[4];\n elif type(eval(args [4]),`&*`(numeric,\{name,symbol,matrix,array\})) then\n coB:=op( select(type,\{op(args[4])\},numeric));\n nameB:=op(remove(type, \{op(args[4])\},numeric));\n lname:=args[4]:\n else \n \+ error \"wrong type of fourth argument %1 in rmulm\",args[4] \n end \+ if;\nelse\n error \"three or four arguments expected in rmulm\"\nend if;\n################################\ntail:=op(subsop(1=NULL,subsop( 1=NULL,[args])));\n################################\n#return (a1,a2,a3 ,coB,nameB,lname,tail);\n################################\nif _proleve l then reset_prolevel:=true:\n _prolevel:=false: \n else reset_prolevel:=false\nend if; \n## ##############################\nif type(a1,matrix) and not type(a1,\{d fmatrix,climatrix,cliscalar\}) and \n type(a2,matrix) and not type (a2,\{dfmatrix,climatrix,cliscalar\})\nthen \n _prolevel:=reset_pr olevel:\n return evalm(a1 &* a2) \n end if;\n##################### ###########\nif type(a1,list(matrix)) and type(a2,list(matrix)) then \+ \n if nops(a1)<>nops(a2) then error \"received lists of unequal leng ths\" \n else\n i:='i':\n _prolevel:=reset_prolevel:\n \+ return [seq(procname(a1[i],a2[i],tail),i=1..nops(a1))]\n end if;\n end if;\n################################\nif type(a1,dfmatrix) and ty pe(a2,dfmatrix) then\n return cdfmatrix(procname(ddfmatrix(a1),ddfma trix(a2),tail))\nend if;\n################################\nif type(a1 ,\{clipolynom,cliscalar,clibasmon,climon\}) then \n if type(a2,list( matrix)) then return (map2(procname,args)) \n elif type(a2,dfmatrix) then \n return subs(Id=1,convert(map2(procname,a1,ddfmatrix(a2 ),tail),dfmatrix))\n end if\nend if;\n############################## ##\nif type(a2,\{clipolynom,cliscalar,clibasmon,climon\}) then \n if type(a1,list(matrix)) then return map(procname,args) \n elif type(a 1,dfmatrix) then \n return subs(Id=1,convert(map(procname,ddfma trix(a1),a2,tail),dfmatrix))\n end if\nend if;\n#################### ############\n#if not member(a3,\{`&*`,`&r`,Cliplus:-climul,cmul,cmulQ ,wedge,qmul,Octonion:-omul\}) then \n# error \"third argument must b e one of the following: cmul, cmulQ, wedge, qmul, omul, &*, &r but rec eived %1 instead\",a3 #\n#end if;\n################################\ni f member(a3,\{`&*`\}) and \n (type(a1,\{clibasmon,climon,clipolynom, climatrix\}) or\n type(a2,\{clibasmon,climon,clipolynom,climatrix\} )) then\nerror \"it makes no sense to apply commutative multiplication &* to non-commuting elements %1 and %2\",a1,a2 \nend 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;\nif not type(a2,matr ix) and type(ar2,matrix) then \n _prolevel:=reset_prolevel:\n \+ return procname(a1,ar2,tail) \nend if;\n########################## ##########################################################\n##If both \+ inputs are of type clipolynom, climon, or clibasmon do the following: \n#################################################################### ################\nif (type(evalm(a1),\{clibasmon,climon,clipolynom\}) \+ \n and \n type(evalm(a2),\{clibasmon,climon,clipolynom\}))\nthen \n if member(a3,\{Cliplus:-climul,cmul,cmulQ\}) then\n _prole vel:=reset_prolevel: \n return simplify(reorder(a3[lname](a1,a2 )))\n elif \n member(a3,\{wedge,qmul,omul\}) then\n _pro level:=reset_prolevel:\n if _warnings_flag and nargs=4 then\n \+ WARNING(sprintf(\"ignoring fourth argument %a\",lname))\n en d if; \n #return simplify(reorder(a3(a1,a2)))\n return e val('simplify'('reorder'(a3(a1,a2))));\n else\n _prolevel:=rese t_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\}) the n \n m2:=map(eval,a2) \n else \n m2:=a2 \n end \+ if;\n L:=map(displayid,convert(m2,'mlist'));\n newL:=[]:\n for i from 1 to nops(L) do newL:=[op(newL),a3[lname](a1,L[i])] end do;\n \+ if not member(a3,\{qmul\}) then\n _prolevel:=reset_prolevel: \n return map(displayid,map(simplify,linalg[matrix](linalg[rowdim]( a2),linalg[coldim](a2),newL)))\n else \n _prolevel:=reset_prole vel: \n return map(simplify,linalg[matrix](linalg[rowdim](a2),l inalg[coldim](a2),newL))\nend if:\nend if: \n######################### ##############\n#a2 is a polynomial and a1 is a matrix\n############## #########################\nif type(evalm(a2),\{clibasmon,climon,clipol ynom,cliscalar\}) \nand \n type(a1,matrix) \n then \n if membe r(a3,\{qmul\}) then \n m1:=map(eval,a1) \n else \n m 1:=a1 \n end if;\n L:=map(displayid,convert(m1,'mlist'));\n \+ newL:=[]:\nfor i from 1 to nops(L) do newL:=[op(newL),a3[lname](L[i] ,a2)] end do;\nif not member(a3,\{qmul\}) then\n _prolevel:=reset_pr olevel:\n return map(simplify,linalg[matrix](linalg[rowdim](a1),lina lg[coldim](a1),newL))\nelse\n _prolevel:=reset_prolevel: \n return map(simplify,linalg[matrix](linalg[rowdim](a1),linalg[coldim](a1),new L))\nend if:\nend if: \n############################################## ########\n##If both inputs are of type matrix, do the following:\n#### ##################################################\nif member(a3,\{qmu l\}) then \n m1:=evalm(map(eval,a1));m2:=evalm(map(eval,a2))\nelse \n m1:=evalm(a1);m2:=evalm(a2); \nend if;\nm1:=displayid(m1):m2:=displa yid(m2):\nr1:=linalg[rowdim](m1):r2:=linalg[rowdim](m2):\nc1:=linalg[c oldim](m1):c2:=linalg[coldim](m2):\nif c1 <> r2 then \n error \"matr ices have incompatible dimensions and cannot be multiplied\" \nend if; \nM:=linalg[matrix](r1,c2,[]);\nk:='k':\nfor i from 1 to r1 do\nfor j \+ from 1 to c2 do\nif a3=`&*` 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_prolevel:\nif membe r(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(sim plify,evalm(M))) \nend if;\nif not member(a3,\{`&*`,`&r`,Cliplus:-clim ul,cmul,cmulQ,wedge,qmul,Octonion:-omul\}) then \n error \"third arg ument must be one of the following: cmul, cmulQ, wedge, qmul, omul, &* , &r but received %1 instead\",a3 end if;\nreturn ;\nend proc:" }} {PARA 0 "" 0 "" {TEXT 261 9 "\nNo. 53: " }{TEXT 343 5 "`&cm`" }{TEXT 344 333 " denotes multiplication of matrices when Clifford product of \+ Cl(B) is applied to matrix entries. One can use index as in &cm[K](p1, p2), &cm[-K](p1,p2), or &cm(p1,p2), &cm(M1,M2. However, when K has bee n assigned a matrix, put K between double quotes as in &cm[''K''](p1,p 2), &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 Cliffor d 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 assi gned a matrix. If K has been assigned a matrix, put K between double q uotes as in &cQm[''K''](p1,p2), or &cQm[''-K''](p1,p2). Procedure can \+ also be used withouht the index as in &cQm(p1,p2).\n(Has been moved to Clifford:-setup).\n" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{TEXT 274 8 "No . 55: " }{TEXT 347 5 "`&wm`" }{TEXT 348 131 " denotes multiplication o f matrices 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 multiplicatio n of matrices 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 matrices 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 " denotes multiplication of matrices when a generic associativ e but possibly not commutative `&r` product is applied to matrix entri es. It can take index. User needs to define procedue `&r` in a similar mannet to `&c`." }{TEXT -1 1 "\n" }{TEXT 479 37 "(Has been moved to C lifford:-setup).\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 59. Procedure " }{TEXT 355 8 "matKrepr" }{TEXT -1 261 " uses previously computed ma trices of basis 1-vectors to find a matrix representation in a minimal left or right ideal of any Clifford polynomial in the given Clifford \+ algebra Cl(Q). Depending on the signature [p,q] of the quadratic form Q, these matrices are " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 119 "real if (p - q) mod 8 is 0, 1, 2; \ncomple x 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 computed with the procedure 'spinorKrepr' in minimal left ideals \+ and stored in a form of a table called 'matrealL' in Maple library. Th e indices of the table are given by the signature [p,q]. To see matric es in a specific signature [p,q], enter" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 17 ">matrealL([p,q]);" }}{PARA 258 " " 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 69 "(assuming, of co urse, that the matrices for this signature are real)." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 359 "Similarly for com plex matrices in dimensions from 3 to 7 which are stored in the file ' matcompL.m' and for quaternionic matrices in dimensions from 2 to 8 wh ich are stored in the file 'matquatL.m'.\n\nSimilarly for matrices rep resenting basis 1-vectors in right minimal ideals; in this case corres ponding files are: 'matrealR.m', 'matcompR.m', and 'matquatR.m'." }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 316 "Matr ices representing Clifford polynomials are generally computed with 'ma tKrepr' much faster than with 'spinorKrepr' because the former is a li near procedure that uses matrix multiplication 'rmulm' to compute matr ices representing basis monomials.\n\nNOTE: This procedure can now han dle semi-simple Clifford algebras." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 13 "Typical use: " }}{PARA 258 "" 0 "" {TEXT -1 92 "to see matrices representing 1-vectors in a 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 4868 "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-2005 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Septem ber 17, 2005`;\n#############################################\n#Checki ng argument types\nif not member(nargs,\{0,1,2\}) then \n error \"wr ong number of arguments: expects 0, 1, or 2 argument(s)\" \nend if;\ni f member(nargs,\{1,2\}) and not type(args[1],\{list,clibasmon,climon,c lipolynom\}) then\n error \"first argument must be of type 'list', c libasmon, climon, or clipolynom but received one of type %1\",whattype (args[1]) \nend if;\nif nargs=2 and not member(args[2],\{'left','righ t'\}) then \n error \"second argument, when used, must be 'left' or \+ 'right', but received %1\",args[2] \nend if;\nif nargs<>0 then a1:=ar gs[1] end if;\nif nargs=0 or type(a1,\{clibasmon,climon,clipolynom\}) \+ then\n if not type(B,matrix) then \n error \"matrix must be as signed to B\"\n elif not type(B,'diagmatrix') then\n error \" bilinear form B must be diagonal\"\n else \n pq:=Bsignature() ;\n pqmod8:=(pq[1]-pq[2]) mod 8;\n pqmod4:=(pq[1]-pq[2]) m od 4;\n flag_simple:=evalb(pqmod4<>1);\n end if;\nelif type(a 1,list) then pq:=a1:pqmod8:=(pq[1]-pq[2]) mod 8 \nelse error \"wrong a rgument(s)\"\nend if;\n############################################## \nif type(a1,\{clibasmon,climon,clipolynom\}) then\n mindex:=maxinde x(a1):Bsize:=linalg[coldim](B):\n if mindex > Bsize then\n erro r \"input error: maximum index in your input %1 is greater than the si ze %2 of the currently defined bilinear form B\",mindex,Bsize \n end if;\nend if;\nif nargs=1 or nargs=0 then a2:='left' else a2:=args[2] \+ end if;\n#read in appropriate data file: \nif member(pqmod8,\{0,1,2\}) then\n if a2='left' then \n #if not assigned(matrealL) t hen readlib(matrealL) end if;\n matdatatable:=matrealL:\n \+ else\n #if not assigned(matrealR) then readlib(matrealR) en d if;\n matdatatable:=matrealR:\n end if;\nelif member(pq mod8,\{3,7\}) then\n if a2='left' then\n #if not assigned (matcompL) then readlib(matcompL) end if;\n matdatatable:=mat compL:\n else \n #if not assigned(matcompR) then readlib( matcompR) end if;\n matdatatable:=matcompR:\n end if;\ne lif member(pqmod8, \{4,5,6\}) then\n if a2='left' then\n \+ #if not assigned(matquatL) then readlib(matquatL) end if;\n m atdatatable:=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(m atdatatable)]);\nif not member(pq,pqsig) then\n error \"matrices for signature %1 in %2 minimal ideal have not been computed yet\",pq,a2 \+ \nend if;\n#######################################\nmatdata:=matdatata ble[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) t hen \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.. (nargs-2)],rmulm(args[nargs-1],args[nargs],`cmulQ`))) \n end if;\ne nd proc:\n########################################\nm:=array(1..nops(m atdata)):\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,'integer s'): \n if a1='Id' then \n if flag_simple then \n retur n linalg[diag](1$dimrepr) \n else \n return convert([li nalg[diag](1$dimrepr)$2],'dfmatrix') \n end if;\n end if; \n \+ if nops(ind)=1 then ind:=op(ind):\n return subs(Id=1,evalm(m[ ind])) \n else return subs(Id=1,reprmulm(seq(evalm(m[ind[i]]),i=1..n ops(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=pr ocname,ans));\nif type(ans,`+`) then ans:=[op(ans)] elif\n type(ans, `*`) then ans:=[ans] else\n error \"unexpected type in matKrepr\" \n end 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:=[o p(L),convert([seq(evalm(co*m[k]),k=1..2)],'dfmatrix')]\nend do:\nif no ps(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 mon omials, Clifford monomials, or Clifford polynomials. Basis monomials a nd Clifford monomials are sorted by grade; in case of a tie it sorts b y lexicographic order based on the basis monomials. However, basis mon omials are put before Clifford monomials. If any of the elements is a \+ Clifford polynomial, then ties are resolved by sorting by the weight o f each element (defined as the sum of the grades of all terms) and the n by then number of Clifford basis monomials in each expression. It re turns true or false in each case, and can be used in sorting a list of basis monomials, Clifford monomials, and Clifford polynomials in the \+ construction sort(L, bygrade).\n\nUse: bygrade(p1,p2) where p1 and p2 \+ are of type 'clibasmon', 'climon', or 'clipolynom';\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1987 "bygrade:=proc(a1::\{clibasmon,climon,clipolyno m\},\n a2::\{clibasmon,climon,clipolynom\}) \nlocal flag1 ,flag2,flag11,flag22,p1,p2,n1,n2,c1,c2,x,w1,w2;\noptions `Copyright (c ) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reser ved.`;\ndescription `Last revised: September 17, 2005`;\n############# ################################\nif type(a1,clibasmon) then p1:=a1;\n flag1:=true:\n fl ag11:=true:\n n1:=Clifford:-extract(p1): \n elif 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 flag2 2:=true:\n n2:=Clifford:-extract(p2): \n \+ elif type(a2,climon) then p2:=op(cliterms(a2));\n \+ flag2:=true:\n flag22:=false:\n \+ n2:=Clifford:-extract(p2): \n else p2:=a2;\n \+ flag2:=false:\nend if;\nx:='x':\nif flag1 and flag2 then\n if no ps(n1)nops(n2) then retur n false\n else \n if evalb(flag11 and flag22) then return lexor der(p1,p2)\n elif evalb(flag11 and not flag22) then return lex order(p1,p2)\n elif evalb(not flag11 and flag22) then return n ot lexorder(p2,p1);\n else return true\n end if;\n end i f; \nelse \n n1:=maxgrade(p1):\n c1:=cliterms(p1):\n w1:=add( maxgrade(x),x=c1):\n n2:=maxgrade(p2):\n c2:=cliterms(p2):\n w2: =add(maxgrade(x),x=c2):\n if n1=n2 then\n if w1=w2 then \n \+ if nops(c1)<=nops(c2) then return true else return false end if;\n else if w1 " 0 " " {MPLTEXT 1 0 2123 "commutingelements:=proc(a1::list(clibasmon)) \nlo cal g,groupgens,L,L2,numfact,f,flag1,flag2,flag3,gen,p,q,i;\nglobal B; \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: September 17 , 2005`;\n#############################################\nif not type(B ,matrix) then \n error \"matrix must be assigned to B\"\nend if;\nif not type(B,'diagmatrix') then \n error \"the bilinear form B is not diagonal as expected\" \nend if;\np:=Bsignature(B)[1]:q:=Bsignature(B )[2]:\nnumfact:=q-RHnumber(q-p):\nflag1:=member(Id,a1):\nL:=remove(mem ber,a1,[Id]):\n#return a1 if it was [Id]\nif L=[] then return args end if; \n#return a1 if had one element of square 1 or [] if the square < >1 \nif nops(L)=1 then\n if cmul(L[1],L[1])=Id then return L\n \+ else return [] \nend if;\nend if;\n#First, sort the list\nL:=sort(L,by grade):\n#Find first element of square 1 mod Id\nflag2:=false:L2:=[]:g roupgens:=[]:\nfor g in L while not flag2 do \n if evalb(cmul(g,g)= Id) then groupgens:=[g];flag2:=true\n else L2:=[op(L2),g] fi end do :\nL:=remove(member,L,[op(L2),op(groupgens)]);\nif L=[] then \n if f lag1 then \n return [Id] else return groupgens \n end if;\nend \+ if; \nif nops(groupgens)=numfact then \n return (sort(groupgens,bygr ade)) end if;\n#Find commuting elements with square 1 mod Id in the sp ecified list of basis monomials\nfor g in L while nops(groupgens)0)) \n then groupgens:=[op(groupgens),g] \n end if; \nend if:\nend do:\nif groupgens=[] then return args else return sort( groupgens,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 o f the type (1/2)*(Id+e[i]), i=1..N, where \{e[i],i=1..N\} is a set of commuting basis monomials with square 1 mod Id in the standard (canon ical) basis of Cl(Q). It is known that when N = q - RHnumber(q-p) the n e is primitive. \n\nTypical use: factoridempotent(f); #here f is e xpected to be an idempotent\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1738 " factoridempotent:=proc(a1::idempotent) \nlocal T,ee,i,L,flag,flag1,fla g2,b1b2,b1,b2,ans;\nglobal B;\noptions `Copyright (c) 1995-2005 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: September 17, 2005`;\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 typ e(B,'diagmatrix') then \n error \"the bilinear form B is not diagona l as expected\" \nend if;\nee:=eval(a1):\nL:=sort(remove(member,conver t(cliterms(ee),list),[Id]),bygrade):\nif nops(L)=1 then \n ans:=(1/2 )*(Id+L[1]);\n if displayid(a1-ans)=0 then return ans else return a1 end if;\nend if;\nflag1:=true:\nwhile flag1 do\nflag2:=true:\nL:=sort (L,bygrade);\nfor b1 in L while flag2 do\nfor b2 in remove(member,L,[b 1]) while flag2 do\n b1b2:=cmulQ(b1,b2):\n if member(b1b2,L) the n 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 retu rn ans else return a1 end if;\nend if;\nL:=sort(L,bygrade);\ni:='i':\n ans:='cmulQ'(seq((1/2)*(Id+L[i]),i=1..nops(L)));\nif eval(ans)-a1=0 th en return (ans) end if;\n#try another sign permutation\nfor i from 1 t o 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 do \nL:=T[nextvalue]();\nans:='cmulQ'(seq((1/2)*(Id+L[i]),i=1..n ops(L)));\nif eval(ans)-a1=0 then flag:=true:return ans end if;\nend d o:\n#return 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 algebr a Cl(V), e.g., to alias e1we2 as e12, or e2we1 as e21. The procedure a ccepts a positive integer p>1 where p denotes the dimension of the vec tor space V. A practical limitation on p is of course the amount of m emory Maple will allocate to store these aliases since every basis mon omial, 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 also when p < 10. Remember that to unalias e12 one needs to eith er restart Maple or simply assign e12:='e12'.\n\nAs a memory saving fe ature, option 'ordered' (or \"ordered\") may be entered as a second pa rameter. If the second parameter is used, aliases are created only for monomials with ordered indices, for example, e12 will be an alias for e1we2.\n\nThe procedure returns a list of aliases to be defined so th ey can bee seen by the user. In order to finish the definition proces s, use 'eval' as shown below.\n" }}{PARA 258 "" 0 "" {TEXT -1 139 "Onc e basis elements have been aliased, Clifford multiplication can be don e 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 804 "makealiases:=proc (a1::posint,a2::\{symbol,string\}) \nlocal L,i,k,l,K,s;\noptions `Copy right (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`,remember;\ndescription `Last revised: September 17, 2005 `;\n#############################################\nif not a1>1 then \n error \"first parameter must be a positive integer larger than one \" \nend if;\nif nargs=2 and not member(a2,\{'ordered',\"ordered\"\}) \+ then\n error \"second optional parameter, when used, must be 'ordere d'\" \nend if;\nk:='k':l:='l':i:='i':\nL:=[seq(op(combinat[choose]([se q(i,i=1..a1)],k)),k=2..a1)];\nif nargs=1 then \n K:=[seq(op(combinat [permute](l)),l=L)];\n s:=seq(cat(e,op(K[i]))=makeclibasmon(K[i]),i= 1..nops(K))\nelse\n s:=seq(cat(e,op(L[i]))=makeclibasmon(L[i]),i=1.. nops(L))\nend if;\nreturn 'alias'(s)\nend proc:\n" }}{PARA 258 "" 0 " " {TEXT -1 18 "No. 64. Procedure " }{TEXT 380 4 "cinv" }{TEXT -1 1285 " calculates a symbolic inverse of any Clifford polynomial p in the gi ven Clifford algebra Cl(B) or in its subalgebra. The procedure determ ines a basis for the smallest subalgebra of Cl(B) in which the inverse might exist. For example, if the polynomial p contains only even gra des, then the inverse is sought in an even subalgebra of Cl(B); otherw ise, the inverse is sought in a Clifford algebra over a vector space V whose dimension equals tha maximum index in p. \n\nIf the bilinear f orm B is not assigned then every Clifford polynomial in Cl(B) has a sy mbolic inverse. If the bilinear form B is assigned then not every elem ent 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 some 'cliscalar' also have no inverses (these elements are cal led here 'almost idempotent').\n\nThus, if B is assigned and the inver se 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. Other wise it returns 'NULL'.\n\nThis procedure can be used with a second op tional argument K of type symbol, name, matrix , or array. In that cas e, it computes the inverse in Cl(K). The seconf argument can also be - K, or any numeric multiple of K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 70 "Typical use: cinv(e1 + 2*e2);cinv(e1 + \+ 2*e2,K); cinv(e1 + 2*e2,-K); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4210 "cinv:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) \nloca l p,pp,pinv,mindex,cinv11,s,aaa,flagB,flagBdiag,S,lname,flagindexed;\n global B,_warnings_flag;\noptions `Copyright (c) 1995-2005 by Rafal Ab lamowicz and Bertfried Fauser. All rights reserved.`,remember;\ndescri ption `Last revised: September 17, 2005`;\n########################### ##################\nif nargs=1 then\n lname:=`B`;\n flagindexed: =false:\nelif nargs=2 and type(args[2],\{symbol,name,array,matrix,`&*` (algebraic,name)\}) then\n lname:=args[2];\n flagindexed:=true: \nelse error \"only one or two arguments are expected\"\nend if;\n#### ########################\ncinv11:=proc(a1,lname)\nlocal i,d,dbasis,N,u ,xm,v,uv,vu,vars,sys,L1,v1,nontrivial;\nglobal evenelement;\n nontri vial:=proc(S::\{set(\{relation,algebraic\}),list(\{relation,algebraic \})\}) \n local istrivial;\n istrivial:=pr oc(x) \n if type(x,relation) then evalb(x) el se evalb(x=0) end if; \n end proc;\n remov e(istrivial,S)\n end proc: \ni:='i':\nd:=maxindex(a1):\n if type(a1,'evenelement') then dbasis:=cbasis(d,'even')\n \+ else dbasis:=cbasis(d) \nend if:\nN:=nops(dbasis):\nu:=cl icollect(reorder(a1)):\nxm:=array(1..N):\nv:=sum(xm[i]*dbasis[i],'i'=1 ..N);\nuv:=collect(cmul[lname](u,v)-Id,dbasis);\nvu:=collect(cmul[lnam e](v,u)-Id,dbasis);\nvars:=\{coeffs(v,dbasis)\};\nsys:=\{coeffs(uv,dba sis),coeffs(vu,dbasis)\};\nsys:=nontrivial(sys); #eliminate trivial eq uations\nL1:=solve(sys,vars);\nif L1=NULL then return (NULL) else \nv1 :=subs(L1,v);\nv1:=reorder(v1):\nv1:=clicollect(v1):\nv1:=map(normal,v 1);\nreturn (eval(v1)): \nend if;\nend proc:\n######################## #############\nif type(a1,cliscalar) then\n if a1<>0 then return 1/a 1 else error \"0 has no inverse\" end if;\nend if;\nmindex:=maxindex(a 1);\nif mindex=0 then return Id/scalarpart(a1) end if;\np:=simplify(re order(a1)):\np:=displayid(p):\npinv:=cinv11(p,lname);\nif evalb(pinv<> NULL) then return pinv end if; \n##################################### \nflagB:=type(evalm(lname),matrix):\nif not flagB then return \"unable to find inverse of %1\",a1 end if;\n################################# ####\nif _warnings_flag then\n WARNING(`testing why entered argument has no inverse...`)\nend if;\n#Checking these special cases only when lname is assigned a matrix:\ns:='s':aaa:='aaa':\nflagBdiag:=type(eval m(lname),diagmatrix):\n#######################################\n###Che cking if element a1 is nilpotent\n#################################### ###\nif type([p,lname],nilpotent) then\n if flagBdiag then \n e rror \"element %1 is nilpotent in signature %2 and as such it has no i nverse\",a1,Bsignature(lname) \n else\n error \"element %1 is n ilpotent in current %2 and as such it has no inverse\",a1,lname \n e nd if;\nend if;\n#######################################\n###Checking \+ if element a1 is idempotent\n#######################################\n if not member(p,\{Id\}) and type([p,lname],idempotent) then\n if fla gBdiag then \nerror \"element %1 is an idempotent in signature %2 and \+ as such it has no inverse\",a1,Bsignature(lname)\n else \nerror \"el ement %1 is an idempotent 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 flagBdiag then \n error \"element 'p'=%1 is almost an idempotent since %2 and as such it has no inverse in signature %3 \", a1,subs(s,'cmul'('p','p')=aaa*'p'),Bsignature(lname)\n else \n \+ error \"element 'p'=%1 is almost an idempotent since %2 and as such i t has no inverse in current %3\", a1,subs(s,'cmul'('p','p')=aaa*'p'),l name\n end if;\nend if;\n#######################################\nS: =\{solve(pp-s*p,s)\}:\nif not evalb(S=\{\}) then \n if flagBdiag the n \n error \"element 'p'=%1 is almost an idempotent since %2 and as \+ such it has no inverse in signature %3\", a1,subs(aaa=op(S),'cmul'('p' ,'p')=aaa*'p'),Bsignature(lname)\n else \n error \"element 'p'=%1 \+ is almost an idempotent since %2 and as such it has no inverse in curr ent\", a1,subs(aaa=op(S),'cmul'('p','p')=aaa*'p'),lname\n end if;\ne nd if;\nreturn NULL\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 65. Procedure " }{TEXT 381 9 "pseudodet" }{TEXT -1 87 " computes pseu dodeterminant 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 534 "pseudodet:=proc(a1::\{climatrix,matrix\}) local M,a,b,c,d;\nopt ions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser . All rights reserved.`;\ndescription `Last revised: September 17, 200 5`;\n#############################################\nM:=map(displayid,e valm(a1)):\nif linalg[rowdim](M) <> 2 or linalg[coldim](M) <> 2 then \+ \n error \"matrix must be 2 x 2\" \nend if;\na:=simplify(M[1,1]): b :=simplify(M[1,2]):\nc:=simplify(M[2,1]): d:=simplify(M[2,2]):\nretur n simplify(cmul(a,reversion(d)) - cmul(b,reversion(c)))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 45 "No. 66. Defining quaternionic mutlipl ication " }{TEXT 382 4 "qmul" }{TEXT -1 687 ". Quaternions are define d as the even elements in Cl(3) (or the para-bivectors in Cl(3)). Thus , a quaternion basis is [Id, e3we2,e1we3,e2we1] and it is available as the first component of global variable '_quatbasis' defined at the in itialization time (type _quatbasis or _quatbasis[1] at the Maple promp t to see it). See P. Lounesto, \"Clifford Algebras and Spinors\", pag e 49, for more information on quaternions. Any element that belongs t o this vector space is now of type 'quaternion'. The infix form of thi s multiplication is `&q`. Via the procedure 'rmulm', the quaternioni c multiplication may also be applied to matrices with quaternionic ent ries and is then denoted by `&qm`." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 121 "NOTE: in order to see answers displa yed in terms of the basis \{Id, qi, qj, qk\}, apply 'qdisplay' to the \+ result of 'qmul'." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 105 "Typical use: qmul(Id + e1we2, e1we3); or (Id + 2*e1w e2) &q (e2we3 + e1we2); or (Id + qi) &q (qj + qk); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1300 "qmul:=proc() local q1,q2,q3,step1,repqmul; \n \+ global B,qi,qj,qk,_default_Clifford_product;\nopti ons `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005 `;\n#############################################\nif member(0,[args]) then return 0 end if;\nif nargs=1 then return qdisplay(args) end if; \n repqmul:=proc() \n if nargs=1 then return args elif\n \+ nargs=2 then return 'qmul'(args) else\n return repqmul(args[1.. (nargs-2)],'qmul'(args[nargs-1],args[nargs])) \n end if;\n end p roc:\nif nargs>2 then \n q3:=eval(repqmul(args)):\n return qdispla y(map(combine,q3,trig)) \nend if;\n_default_Clifford_product:='cmulNUM ':\nq1:=eval(args[1]):q2:=eval(args[2]):\nif type(q1,`^`) or type(q2,` ^`) then \n error \"illegal expression found: use 'qinv' for the qua ternionic inverse\" \nend if;\nif type(q1,cliscalar) or type(q2,clisca lar) then \n return qdisplay(q1*q2) \nend if;\nif q1=Id then return \+ qdisplay(q2) end if;\nif q2=Id then return qdisplay(q1) end if;\nif no t type(q1,quaternion) or not type(q2,quaternion) then\n error \"wron g input type: input must be of type 'cliscalar' or 'quaternion'\" \nen d if;\nstep1:=reorder(cmul(q1,q2));\nreturn qdisplay(map(combine,clico llect(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 conju gation " }{TEXT 387 8 "q_conjug" }{TEXT -1 112 ". Recall that complex conjugation was named 'c_conjug' while the Clifford conjugation was j ust 'conjugation'. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 68 "Typical use: q_conjug(Id + 2*e1we2); or q_conjug(I d + 2*qi + qk); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 559 "q_conjug:=p roc(q::algebraic) local q1; global qi,qj,qk;\noptions `Copyright (c) 1 995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: September 17, 2005`;\n################ #############################\nif type(q,matrix) then return map(procn ame,q) elif\n type(q,\{cliscalar,quaternion\}) then\nq1:=eval(q):\ni f type(q1,cliscalar) then return q1 \nelse\n return qdisplay(2*scal arpart(q1)-q1)\nend if;\nelse\n error \"wrong input types: input mus t 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 us e: qnorm(Id + 2*e1we2); or qnorm(Id + qi + qj + qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 448 "qnorm:=proc(q ::\{cliscalar,quaternion\}) local q1,n,co; global qi,qj,qk;\noptions ` Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n# ############################################\nq1:=expand(eval(q));\nif type(q1,cliscalar) then return abs(q1) \nelse\n n:=0:for co in [coe ffs(q1,cliterms(q1))] do n:=n+co^2 end do;\n return combine(sqrt(n), trig) \nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 38 "No. 70. Quaternionic inverse is named " }{TEXT 389 4 "qinv" }{TEXT -1 141 ". \+ Recall that the inverse of a Clifford polynomial can be calculated wi th 'cinv' and that quaternions form a noncommutative division ring. \+ " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 66 "T ypical use: qinv(Id + 2*e1we2); or qinv(Id + 2*qi + 3*qj + qk); " }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 458 "qi nv:=proc(q::\{cliscalar,quaternion\}) local q1,q2; \noptions `Copyrigh t (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: September 17, 2005`;\n######### ####################################\nq1:=eval(q):\nif q1=0 then error \"zero quaternion has no inverse\"\nelif type(q1,cliscalar) and q1<>0 then return 1/q1\nelse q2:=q_conjug(q1)/(qnorm(q1))^2:\n return q display(map(combine,q2,trig))\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 71. Procedure " }{TEXT 390 8 "qdisplay" }{TEXT -1 101 " displays quaternions or matrices with quaternionic entries in te rms of the basis \{Id, qi, qj, qk\}. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT 360 93 "Typical use: qdisplay(e1we2 + 2*I d); map(qdisplay, matrix(2, 2, [Id, e1we2, e2we3, e1we3])); " }{TEXT -1 2 " \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 714 "qdisplay:=proc(a1::\{ algebraic,array\}) local q; global qi,qj,qk;\noptions `Copyright (c) 1 995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: September 17, 2005`;\n################ #############################\nif type(a1,matrix) then\n if not type (a1,climatrix) then \n return evalm(a1) else \n return map(q display,a1) \n end if;\nend if;\nq:=eval(a1):\nif type(q,cliscalar) \+ then return q end if;\nif type(q,quaternion) then\nq:=map(combine,clic ollect(reorder(q)),trig);\nreturn coeff(q,Id)-coeff(q,e1we2)*'qk'+coef f(q,e1we3)*'qj'-coeff(q,e2we3)*'qi'\nelse \nerror \"wrong input type: \+ input must be of type 'cliscalar', 'quaternion', or 'matrix' \" \nend \+ if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 72. Procedure \+ " }{TEXT 391 5 "rot3d" }{TEXT -1 161 " rotates a vector in 3-dimension al Euclidean space V using the quaternion multiplication. Namely, an y vector v is transformed according to the following law: " }}{PARA 258 "" 0 "" {TEXT -1 1 " " }}{PARA 258 "" 0 "" {TEXT -1 84 " \+ v -> q &c v &c qinv( q) " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 459 "where q is a quaternion given in the basis [Id, e1we2, e1we3, e2w e3]. The first entry should be a vector (or any element of the Cliffor d algebra) while the second element is a quaternion. Type '_quatbasis ' to see how quaternions are defined here. Elements 'qi', 'qj', 'qk' \+ are defined at the time of initialization and denote the pure-quaterni on basis elements. It is assumed that the user has defined a bilinear form B as the 3 x 3 identify matrix as in:\n" }}{PARA 258 "" 0 "" {TEXT -1 28 " >B := linalg[diag](1$3); \n" }}{PARA 258 "" 0 "" {TEXT -1 108 "before using 'rot3d'. Of course, 'rot3d' will also work if th e first argument were any element in Cl(3). \n" }}{PARA 258 "" 0 "" {TEXT -1 296 "NOTE: traditionally one uses \{1, i, j, k\} to denote a \+ quaternion basis. Here, we are using symbol 'qi' for 'i', 'qj' for 'j ', and 'qk' for 'k'. Symbol 'Id' denotes, as usual, the unit element \+ in all Clifford algebras as well as the unit element in reals, complex es, quaternions, and octonions. " }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 55 "Typical use: rot3d(e1 + e2, Id + 2*qi - 3*qj + 2*qk); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 858 "rot3d:=proc(a1::\{cliscalar,clibasmon,climon,clipoly nom\},\n a2::quaternion) \nlocal q2,q2inv; global B,qi,qj,q k; \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n#############################################\nif not ass igned(B) or not type(B,matrix) then \n error \"bilinear form B has n ot been assigned yet. It must be defined as the identity 3 x 3 matrix. \"\nend if:\nif not linalg[equal](B,linalg[diag](1$3)) then \n error \"the identity 3 x 3 matrix must be assigned to B\" \nend if;\nif nar gs <> 2 then \n error \"two arguments needed of type algebraic and q uaternion\" \nend if; \nq2:=clisort(map(combine,eval(a2),trig)); \nq2i nv:=clisort(map(combine,eval(qinv(eval(q2))),trig)); \nreturn clicolle ct(clisort(map(combine,cmulQ(q2,a1,q2inv),trig))) \nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 73. Procedure " }{TEXT 392 9 "ispro duct" }{TEXT -1 238 " can determine whether the given Clifford polynom ial, e.g. p := Id + 4*e1we2 + e3we4, is a product of 1-vectors in the given Clifford algebra. It can be used with two options `all`, or `an y`, or can be used without any option as follows:" }}{PARA 258 "" 0 " " {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 12 "Typical use:" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 48 "ispro duct(p); answers true or false;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 151 "isproduct(p, 'any'); \+ answers true or false, and gives a list of n vectors [v1, v2, ..., vn] such that the Clifford product v1 &c v2 &c ... &c vn = p;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 161 "isproduct( p, 'all'); answers true or false, and gives a list of general vecto rs [v1, v2, ..., vn] such that the Clifford product v1 &c v2 &c ... &c vn = p;\n\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4896 "isproduct:=proc( p::\{cliscalar,clibasmon,climon,clipolynom\},\n s::\{st ring,symbol\}) \nlocal M,maxg,T,co,vv,x,cf,pnew,p1,L,v,j,S,S2,i,v1v2,e xpr,t,sys,\nvars,sol,ventries,flag,flagB,flagtB,param,flagsol,eq,P1,P2 ,die,parvalues;\nglobal _MaxSols,B;\noptions `Copyright (c) 1995-2005 \+ by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndesc ription `Last revised: September 17, 2005`;\n######################### ####################\nif not member(nargs,\{1,2\}) then\n error \"one \+ or two arguments needed of type 'cliscalar', 'clibasmon', 'climon', 'c lipolynom', and 'symbol'\"\nend if;\nif nargs=2 and not member(s,\{'al l','any'\}) then\n error \"second (optional) argument must be 'all' \+ or 'any'\"\nend if;\nif not type(B,diagmatrix) then \n error \"diago nal matrix must be assigned to B\" end if;\nmaxg:=maxgrade(p);\n###### ###############################################\n#An element of grade \+ 0 is always factorable in Cl(B):\n#################################### #################\nif maxg=0 then \n if nargs=1 then return true end if;\n flag:=false:\n for i from 1 to linalg[coldim](B) while not \+ flag do\n if B[i,i]<>0 then flag:=true;\n return [true, [(scalarpart(p)/B[i,i])*e||i,e||i]] \n end if;\n end do;\nerro r \"none of the basis 1-vectors has a square equal to 1 or -1\" \nend \+ if;\n#####################################################\n#Any 1-vec tor is already factored:\n############################################ #########\nif vectorpart(p,1)-p=0 then \n if nargs=1 then return tru e\n else return [true,[p]] \n end if;\nend if;\n####### ##############################################\n#Any basis monomial is already factored:\n################################################## ###\nflagB:=type(B,diagmatrix):\np1:=factor(reorder(displayid(p))):\nf lagtB:=evalb(type(p1,\{clibasmon,climon\}) and flagB):\nif flagtB then \n S:=op(Clifford:-extract(p1,'integers'));\n if nargs=1 th en 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 doe s 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(Cli fford:-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:=cmu l(op(vv));\n pnew:=cmul(p,cf,cf,cf);\n if nargs=1 then M:=procname (pnew) \n elif\n nargs=2 then L:=procname(pnew,s);\n \+ M:=[L[1],[op(L[2]),op(vv)]]; \n end if;\n return M\nend if; \n#####################################################\n#This i s the most general case when no common indices\n#in monomial terms are found:\n#####################################################\nS2:=ma p(Clifford:-extract,cliterms(p),'integers');\nS:=\{op(map(op,S2))\}; \+ \nv:=table([]):\nfor j from 1 to maxg do\nv[j]:=0:\nfor i in S do v[j] :=v[j]+cat(x,j,i)*cat(e,i) \nend do;\nend do;\nv1v2:=cmul(seq(v[j],j=1 ..maxg));\nexpr:=clicollect(simplify(reorder(p-v1v2))):\nt:=cliterms(e xpr);sys:=\{\}:\nfor i from 1 to nops(t) do sys:=\{op(sys),coeff(expr, op(i,t))=0\} end do:\nvars:=sort([op(indets(sys))],lexorder); \n_MaxSo ls:=1: #setting maximum number of solutions to one\nvars:=convert(va rs,set):\nsol:=[solve(sys,vars)]:\nif nops(sol)=0 then return false en d if;\nventries:=[seq(v[j],j=1..maxg)];\n############################# ##########################\n#Finally, we need to return result in appr opriate form.\n#By now, if p were not factorable, 'false' should have \n#been returned:\n################################################### ####\nif nargs=1 then return true end if; \nif nargs=2 and s='all' the n return [true,subs(sol[1],ventries)] end if; \n###################### ###################################\n#If the second parameter is 'any' , assign random values\n#to the parameters showing up in the answer. T hese random\n#values will change with each execution of the program:\n #########################################################\nif nargs=2 \+ and s='any' then \nparam:=proc(a1::\{`=`\}) \n if lhs(a1)=rhs(a1) or rhs(a1)=0 then true else false end if;\nend proc:\nflagsol:=false:\nf or 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 unio n \{eq\}\n else P1:=P1 union \{lhs(eq)=parvalues[die()] \};\n end if;\nend do;\nP2:=remove(param,S2):\nL:=map(op,subs(P2,vent ries));\nif not member(0,subs(P1,map(denom,L))) then flagsol:=true end if;\nend do:\nif flagsol then return [true,subs(P1,subs(P2,ventries)) ]\n else return [true,subs(sol[1],ventries)]\nend if;\nend i f;\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 a s defined in P. Lounesto, \"Clical and counter-examples\", in eds. R. Ablamowicz, P. Lounesto, and J. Parra, `Clifford algebras with symbol ic and numeric computations`, Birkhauser, Boston, 1996, page 19." }} {PARA 258 "" 0 "" {TEXT -1 349 "\nVahlen matrix V is a 2 x 2 matrix wi th entries in a Clifford algebra Cl(p, q) such that if \n\n V := matri x(2, 2, [a, b, c, d]); \+ \+ \nand a,b,c,d are elements in Cl(p, q), then th e 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 vecto rs;" }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 74 "2. the pseudodeterminant of V is +1 or -1 (or Id or -Id in the a lgebra);" }}{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 "Typical use: isVahlenmatrix(V);" }} {PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 120 "V := matrix(2, 2, [Id - e1we4, -e1 + e4, e1 + e4, Id + e1we4]) (this exam ple of Vahlen matrix is due to Johannes Maks)." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1214 "isVahlenmatrix:=p roc(cm::\{matrix,climatrix\}) \nlocal expr1,expr2,a,b,c,d,m; global B; \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: September 17 , 2005`;\n#############################################\nif not type(B ,matrix) then \n error \"square matrix must be assigned to B\" \nend if;\nif linalg[rowdim](cm)<>2 or linalg[coldim](cm)<>2 then \n erro r \"to calculate pseudodeterminant matrix must be 2 x 2\" \nend if;\nm :=displayid(cm):\na:=simplify(m[1,1]):b:=simplify(m[1,2]):\nc:=simplif y(m[2,1]):d:=simplify(m[2,2]):\n###################################### ####\n### Condition 1:\n##########################################\nif a<>0 then if not isproduct(a) then return false fi end if;\nif b<>0 t hen 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 isp roduct(d) then return false fi end if;\n############################## ############\n### Condition 2:\n###################################### ####\nif not member(pseudodet(m),\{1,-1,Id,-Id\}) then return false en d if;\n##########################################\n### Condition 3:\n# #########################################\n" }{TEXT 359 0 "" } {MPLTEXT 1 0 585 "expr1:=simplify(cmul(a,reversion(b)));\nexpr2:=simpl ify(vectorpart(expr1,1));\nif not evalb(simplify(expr1-expr2)=0) then \+ return false end if;\nexpr1:=simplify(cmul(reversion(b),d));\nexpr2:=s implify(vectorpart(expr1,1));\nif not evalb(simplify(expr1-expr2)=0) t hen return false end if;\nexpr1:=simplify(cmul(d,reversion(c)));\nexpr 2:=simplify(vectorpart(expr1,1));\nif not evalb(simplify(expr1-expr2)= 0) then return false end if;\nexpr1:=simplify(cmul(reversion(c),a));\n expr2:=simplify(vectorpart(expr1,1));\nif not evalb(simplify(expr1-exp r2)=0) then return false end if;\nreturn true\nend proc:" }}{PARA 0 " " 0 "" {TEXT -1 0 "" }{MPLTEXT 1 0 0 "" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 75. Procedure " }{TEXT 394 10 "climinpoly" }{TEXT -1 407 " fin ds 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 linearly independent, k= 1..(n-1) where n = degree of the minimal polynomial of p. If the secon d optional argument is 'horner' then polynomial is returned in 'horner ' form. This procedure can accept now optional index." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 83 "Typical use: climi npoly(p);climinpoly[K](p);\n climinpoly(p,'s');" }} {PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1408 "c liminpoly:=proc(p::\{cliscalar,clibasmon,climon,clipolynom\})\nlocal d p,L,flag,pp,expr,a,k,eq,sys,vars,sol,poly,lname;\noptions `Copyright ( c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights rese rved.`;\ndescription `Last revised: September 17, 2005`;\n############ #################################\nif type(op(procname),procedure) the n\n lname:=`B`;\n else\n lname:=op(procname);\nend if;\ndp:=dis playid(p):\nif maxgrade(dp)=0 then L:=[Id] else L:=[Id,dp] end if;\nfl ag:=false:k:='k':a:='a':\nwhile not flag do\npp:=cmul[lname](L[nops(L) ],dp):\nexpr:=expand(add(a[k]*L[k],k=1..nops(L)));\neq:=clicollect(pp- expr);\nsys:=\{coeffs(eq,cliterms(eq))\};\nvars:=\{seq(a[k],k=1..nops( L))\};\nsol:=solve(sys,vars):\nif sol<>NULL then flag:=true else L:=[o p(L),pp] end if;\nend do;\npoly:='x'^nops(L)-add(a[k]*'x'^(k-1),k=1..n ops(L));\npoly:=sort(subs(sol,poly)); \nif nargs=1 then return poly\ne lif nargs=2 then\n if args[2]='powers' then return [poly,L]\n \+ elif args[2]='horner' then return convert(poly,horner)\n else \+ error \"second (optional) argument must be 'powers' or 'horner' \"\n \+ end if;\nelif nargs=3 then\n if member(args[2],\{'powers','horn er'\}) and\n member(args[3],\{'powers','horner'\}) then\n \+ return ([convert(poly,horner),L])\n else error \"wrong arg uments\"\n end if;\nelse error \"wrong number of arguments: one, t wo, or three arguments are needed only\"\nend if;\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 18 "No. 76. Procedure " }{TEXT 395 15 "subs _climinpoly" }{TEXT -1 283 " substitutes any Clifford polynomial p int o any polynomial pol in one variable. It may be used with an optional \+ third argument in which case it returns unevaluated polynomial pol in \+ 'horner' form. For example, one can use this procedure to verify that \+ the given Clifford polynomial p" }{TEXT 356 1 " " }{TEXT -1 37 "satisf ies its own minimal polynomial." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }} {PARA 258 "" 0 "" {TEXT -1 197 "Typical use: subs_climinpoly(p,pol);\n subs_climinpoly(p,pol, 'horner');\n \+ subs_climinpoly(p,pol, \"horner\");\n subs_cli minpoly(p,pol, horner);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1334 "subs _clipolynom:=proc(clinumber::\{symbol,cliscalar,clibasmon,climon,clipo lynom\},\n minpoly::polynom,o::\{symbol,string \}) \nlocal ph,d,k,r,q,h,expr,s,var,varx,dclinumber;\noptions `Copyrig ht (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: September 17, 2005`;\n######## #####################################\nph:=convert(minpoly,horner);\nv ar:=op(remove(type,indets(ph),indexed));\nif not type(eval(clinumber), \{clibasmon,climon,clipolynom\}) \n then return subs(var=clinumber,p h) \nend if;\nif nops(\{var\})<>1 then varx:=op(select((member,\{var\} ,\{x,y,z\}))) else varx:=var end if;\nif nops(\{varx\})<>1 then \n e rror \"expecting only one of x, y, or z as a variable in %1 but found \+ %2\",minpoly,varx \nend if:\nd:=degree(ph,varx);\nh:=ph:\nfor k from 1 to d do\n r[k]:=rem(h,x,x,'s');\n q[k]:=convert(s,horner);\nh:= q[k];\nend do:\ndclinumber:=displayid(clinumber):\nexpr:=clicollect(r[ d]*Id+q[d]*dclinumber);\nfor k from d-1 to 1 by -1 do\n expr:=r[k]* Id+'cmul'(expr,dclinumber);\nend do:\nif nargs=2 then return simplify( eval(expr))\nelif nargs=3 then \n if args[3]='horner' then return ex pr \n else \n error \"third (optional) argument, when used, \+ must be 'horner', but received %1 instead\",args[3]\n end if;\nelse \+ error \"wrong number of arguments\"\nend if;\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 19 "No. 77. Procedure " }{TEXT 396 4 "sexp" } {TEXT -1 427 " finds a power series expansion of a Clifford polynomial p up to and including order n modulo the minimal polynomial of p. It \+ is recommended that this procedure be used when n > d, where d is the \+ degree of the minimal polynomial of p. Otherwise, use 'cexp' or 'cexpQ ' instead. The reason is that 'sexp' is faster than 'cexp' when n > d, but is is slower when n <= d. This procedure can use an optional argu ment such as K or -K." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 " " 0 "" {TEXT -1 49 "Typical use: sexp(p,4); sexp(p,4,K);sexp(p,4,-K); " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1527 "sexp:=proc(p::\{numeric,cliscalar,clibasmon,climon,clipolynom\}, n::nonnegint) \nlocal k,pp,pol,powrs,co,te,nte,lname,coB,nameB;\noptio ns `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: September 17, 2005` ;\n#############################################\nif nargs=2 then\n \+ coB:=1:\n nameB:=`B`: \n lname:=`B`: \nelif nargs=3 then\n i f 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(t ype,\{op(args[3])\},numeric));\n nameB:=op(remove(type,\{op(args [3])\},numeric));\n lname:=args[3]:\n else \n error \"w rong type of third argument in sexp. See ?sexp for more help.\" \n e nd if;\nelse\n error \"two or three arguments expected in sexp. See \+ ?sexp for more help.\"\nend if;\n##################################### \nif n=0 then \n if type(p,\{numeric,'cliscalar'\}) then return 1 el se return Id fi\nend if;\nk:='k':\nif type(p,\{numeric,cliscalar\}) th en return add(p^k/k!,k=0..n) end if;\nif evalb(vectorpart(p,0)=p) then pp:=scalarpart(p);\n return (add(pp^k/k!,k=0..n)*Id) \nend if;\npol :=climinpoly[lname](p,'powers');\npowrs:=pol[2]:\n### readlib(powmod); \nk:='k':te:='te':\npol:=collect(add(powmod('x',k,pol[1],'x')/k!,k=0.. n),'x');\nco:=[coeffs(pol,'x','te')]:\nte:=[te]:\nnte:=nops(te):\nfor \+ k from 1 to nte do \n te[k]:=powrs[degree(te[k],'x')+1] \nend do;\n return clicollect(add(co[k]*te[k],k=1..nte))\nend proc:\n" }}{PARA 0 " " 0 "" {TEXT 358 18 "No. 78. Procedure " }{TEXT 397 8 "all_sigs" } {TEXT 398 383 " gives signatures of all real, real simple, real semi-s imple, complex, quaternionic, quaternionic simple, and quaternionic se mi_simple Clifford algebras up to and including the dimension specifie d as the first parameter. Second parameter, when used, must be 'real', 'complex', or 'quat', while the third parameter must be 'simple' or ' semisimple'.\n\nUse: all_sigs(9,'real','simple');\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2808 "all_sigs:=proc(r) \nlocal s1,s2,mi,ma,P,Q,p,q,pq ,r_pq,c_pq,q_pq,x,\nsimple_r_pq,simple_q_pq,semisimple_r_pq,semisimple _q_pq;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Septem ber 17, 2005`;\n#############################################\nif narg s=2 then \n s1:=args[2]:\nelif nargs=3 then \n s1:=args[2]:\n s2 :=args[3]:\nend if; \nif not type(r,range) or \n not type (s1,\{string,symbol\}) or\n not type(s2,\{string,symbol\})\nthen\nWA RNING(`try first argument as range, e.g., 1..9, second argument as 're al', 'complex', or 'quat', and third arguments as 'simple' or 'semisim ple' instead of:`);\nreturn 'procname(args)'\nend if;\n############### #########\nmi:=min($r):ma:=max($r):\nP:=\{$0..9\}:Q:=\{$0..9\}:\npq:=[ ]:\nfor p in P do\nfor q in Q do \n if p+q<=ma and p+q>=mi then pq: =[op(pq),[p,q]] end if: \nend do:\nend do:\nr_pq:=[]:c_pq:=[]:q_pq:=[] :\nfor x in pq do\np:=x[1]:q:=x[2]:\nif member((p - q) mod 8,\{0,1,2\} ) then r_pq:=[op(r_pq),x] end if;\nif member((p - q) mod 4,\{3\}) then c_pq:=[op(c_pq),x] end if;\nif member((p - q) mod 8,\{4,5,6\}) then q _pq:=[op(q_pq),x] end if;\nend do:\n################################## \nif nargs=1 then return pq end if;\n################################# #\nif nargs=2 then\n if s1='real' then return r_pq elif\n s1='c omplex' then return c_pq elif\n s1='quat' then return q_pq else\n error \"second input string must be 'real', 'complex' or 'quat' \+ but received %1\",args[2] \n end if:\nend if: \n################### ###############\nif s1='real' then\n simple_r_pq:=[]:semisimple_r _pq:=[]:\n for x in r_pq do \n if member(x[1]-x[2] mod 8 ,\{1\}) then \n semisimple_r_pq:=[op(semisimple_r_pq),x] \+ \n else \n simple_r_pq:=[op(simple_r_pq),x]\n \+ end if;\n end do:\n if s2='simple' then return simple_ r_pq elif\n s2='semisimple' then return semisimple_r_pq else\n error \"third argument must be 'simple' or 'semisimple' but r eceived %1\",args[3]\n fi\nend if;\n############################# #####\nif s1='complex' then\n if s2='simple' then return c_pq elif\n s2='semisimple' then return [] \n end if:\nend if;\n########## ########################\nif s1='quat' then\n simple_q_pq:=[]:sem isimple_q_pq:=[]:\n for x in q_pq do \n if member(x[1]-x [2] mod 8,\{5\}) then \n semisimple_q_pq:=[op(semisimple_q _pq),x] \n else \n simple_q_pq:=[op(simple_q_pq), x]\n end if;\n end do:\n if s2='simple' then return simple_q_pq elif\n s2='semisimple' then return semisimple_q_p q else\n error \"third argument must be 'simple' or 'semisimpl e' but received %1 instead\",args[3]\n end if:\nend if;\nerror \" wrong number of arguments. See ?all_sigs for more help.\"\nend proc:\n " }}{PARA 0 "" 0 "" {TEXT 357 18 "No. 79. Procedure " }{TEXT 399 9 "ad fmatrix" }{TEXT 400 116 " accomplishes addition of two matrices of typ e 'dfmatrix', that is, matrices whose entries belong to a double field \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 371 "adfmatrix:=proc(M1::dfmatrix , M2::dfmatrix) local L1, L2;\noptions `Copyright (c) 1995-2005 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: September 17, 2005`;\n############################### ##############\n L1:=ddfmatrix(M1);\n L2:=ddfmatrix(M2);\n re turn 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: Procedur es " }{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 scalar bilinear forms in the spinor ideal S of Cl(Q).\n\nUsage: beta_plus(psi,phi,f); beta_plus(psi,phi,f),'s'); beta_minus(psi,phi,f); beta_minus(psi,phi, f),'s'); where psi and phi are spinors, f is an idempotent, and 's' is an optional argument that will store 'purescalar'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2006 "beta_plus:= proc(psi,phi,f) \nlocal locf,locda ta,y,m,flag,mons,uu,eq,lambda,sys,sol,Kbas,v,i,vars,flagf;\nglobal B,_ prolevel;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Be rtfried Fauser. All rights reserved.`;\ndescription `Last revised: Sep tember 17, 2005`;\n#############################################\nif n ot _prolevel then\n if not type(psi,\{cliscalar,clibasmon,climon,clipo lynom\}) then \n error \"first argument must be of type 'cliscalar', \+ 'clibasmon', 'climon', or 'clipolynom'\" \n end if;\n if not type(phi, \{cliscalar,clibasmon,climon,clipolynom\}) then \n error \"second arg ument must be of type 'cliscalar', 'clibasmon', 'climon', or 'clipolyn om'\" \n end if;\nend if;\n###Load in pre-computed data and check if i dempotents 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(locf) or f=-eva l(locf));\n if not flagf then\nerror \"when K = C or K = H, primitiv e idempotent f = plus/minus clidata(B)[4] or its grade involution\"\n \+ end if;\nend if;\n###\n y:=cmul(reversion(expand(psi)),expand(phi ));\n if y = 0 then return 0 end if;\n m := 'm';i:='i':\n fla g := false;\n mons := cbasis(linalg[coldim](B));\n v := array(1 \+ .. nops(Kbas),[]);\n lambda := add(v[i]*Kbas[i],i=1..nops(Kbas));\n for m in mons while not flag do\n uu := m;\n eq := c licollect(cmul(m,y) - expand(cmul(lambda,f)));\n sys := \{coeff s(eq, cliterms(eq))\};\n vars := \{seq(v[i], i = 1 .. nops(Kbas ))\};\n sol := solve(sys, vars);\n flag := not evalb(sol = NULL)\n end do:\n if nargs = 4 then\n if not type(args[ 4],name) or type(args[4],protected) then \n error \"fourth op tional argument, when used, must be of type unprotected name\"\n \+ else assign(args[4],uu) \n end if;\n end if;\n lambda:=su bs(sol,lambda):\n if vectorpart(lambda,0)=lambda then return (scala rpart(lambda)) \n else return lambda\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2038 "beta_minus:= proc(psi,phi,f) \n local locf,locdata,y,m,flag,mons,uu,eq,lambda,sys,sol,Kbas,v,i,vars,fl agf;\nglobal B,_prolevel;\noptions `Copyright (c) 1995-2005 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: September 17, 2005`;\n################################### ##########\nif not _prolevel then\n if not type(psi,\{cliscalar,clibas mon,climon,clipolynom\}) then \n error \"first argument must be of ty pe 'cliscalar', 'clibasmon', 'climon', or 'clipolynom'\" \n end if;\n \+ if not type(phi,\{cliscalar,clibasmon,climon,clipolynom\}) then \n err or \"second argument must be of type 'cliscalar', 'clibasmon', 'climon ', or 'clipolynom'\" \n end if;\nend if;\n###Load in pre-computed data and check if idempotents are the same\nlocdata := clidata(B):\nlocf : = eval(locdata[4]);\nKbas := locdata[6];\nif nops(Kbas)>1 then\n fla gf:=evalb(f=eval(locf) or f=gradeinv(locf) or \n f=-gra deinv(locf) or f=-eval(locf));\n if not flagf then\n error \"wh en K = C or K = H, primitive idempotent f = plus/minus clidata(B)[4] o r its grade involution\"\n end if;\nend if;\n###\n y := cmul(conj ugation(expand(psi)),expand(phi));\n if y = 0 then return 0 end if; \n m := 'm';i:='i':\n flag := false;\n mons := cbasis(linalg[ coldim](B));\n v := array(1 .. nops(Kbas),[]);\n lambda := add(v [i]*Kbas[i],i=1..nops(Kbas));\n for m in mons while not flag do\n \+ uu := m;\n eq := clicollect(cmul(m,y) - expand(cmul(lambd a,f)));\n sys := \{coeffs(eq, cliterms(eq))\};\n vars := \{seq(v[i], i = 1 .. nops(Kbas))\};\n sol := solve(sys, vars); \n flag := not evalb(sol = NULL)\n end do:\n if nargs = 4 then\n if not type(args[4],name) or type(args[4],protected) the n \n error \"fourth optional argument, when used, must 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 o r from a serquence of to matrices.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 923 "cdfmatrix:=proc() local l1,l2,L,i,j,m,n,m1,m2,MN;\noptions `Cop yright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: September 17, 2005`;\n#### #########################################\nif nargs=1 and type(args[1] ,list(\{matrix,array\})) \n then m1,m2:= evalm(args[1][1 ]),evalm(args[1][2]);\nelif nargs=2 and type(args[1],\{matrix,array\}) and type(args[2],\{matrix,array\}) \n then m1,m2:= eval m(args[1]),evalm(args[2])\nelse error \"wrong number or types of argum ents. See ?cdfmatrix for help.\" \nend if;\n l1:=convert(m1,mlist); \n l2:=convert(m2,mlist);\n L:=[];\n for i to nops(l1) do \n \+ L:=[op(L),[l1[i],l2[i]]] \n end do:\n m:=linalg[rowdim] (m1);\n n:=linalg[rowdim](m1);\n MN:=linalg[matrix](m,n,[]);\n \+ for i to m do \n for j to n do MN[i,j]:=L[(i-1)*n+j] \n en d do:\n end do:\n return evalm(MN)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 363 18 "No. 83. Procedure " }{TEXT 407 9 "ddfmatrix" }{TEXT 408 64 " decomposes a matrix over double field into a pair of matrices .\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 462 "ddfmatrix:=proc(M::dfmatrix ) local m,n,i,L1,L2,L;\noptions `Copyright (c) 1995-2005 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n###################################### #######\n m:=linalg[rowdim](M);\n n:=linalg[coldim](M);\n L:= convert(M,mlist);\n L1:=[seq(L[i][1],i=1..nops(L))];\n L2:=[seq( L[i][2],i=1..nops(L))];\n return [linalg[matrix](m,n,L1),linalg[mat rix](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 786 "diagonalize:=proc(m::symmatrix) local locB,flag,i,j, L,v,S,Bdiag;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: \+ September 17, 2005`;\n#############################################\ni f linalg[coldim](m)<>linalg[rowdim](m) then\n error \"expected a squ are matrix as input\" \nend if;\nif type(m,diagmatrix) then \n retur n 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]) th en flag:=false end if: \nend do: \nif not flag then \n error \"since matrix entered does not have a complete set of linearly independent e igenvectors, it is not diagonalizable\" \nend if;\nreturn linalg[diag] (seq(seq(L[i][1],j=1..L[i][2]),i=1..nops(L)))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 365 6 "No. 85" }{TEXT -1 1 "." }{TEXT 366 11 " Procedure " }{TEXT 411 9 "mdfmatrix" }{TEXT 412 46 " multiplies two matrices ov er a double field.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 367 "mdfmatrix: =proc(M1::dfmatrix,M2::dfmatrix) local L1, L2;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: September 17, 2005`;\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 1473 "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-2005 by Rafal Ablamowicz and Bertfried Fauser . All rights reserved.`;\ndescription `Last revised: September 17, 200 5`;\n#############################################\n#if a1=a2 then ret urn [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 \+ then\n S:=[op(S),llist[i] ]:\n end if: \n end if: \n end if:\n end do:\nreturn S\nend if;\nif nargs=3 then\n llist 1:=`union`(op(map(cliterms,remove(member,\{seq(op(\{cmul(a1,g),cmul(g, a1)\}),g=a3)\},\{0\})))):\n llist2:=`union`(op(map(cliterms,remove(me mber,\{seq(op(\{cmul(a2,g),cmul(g,a2)\}),g=a3)\},\{0\})))):\n llist3: =map(op@cliterms,convert(a3,set)); \n llist:=convert(`union`(llist1, llist2,llist3),list):\n llist:=sort([op(llist),op(cliterms(op(a3)))], bygrade):\nelse\n llist:=cbasis(max(maxindex(a1),maxindex(a2))):\nend if;\nn:=nops(llist):\ng:=add(_X[i]*llist[i],i=1..n);\nvars:=\{seq(_X[ i],i=1..n)\}:\nxy:=clicollect(cmul(g,a1)-cmul(a2,g)):\nsys:=\{coeffs(x y,llist)\};\nsys:=map(normal,sys);\nsol:=solve(sys,vars);\nreturn subs (sol,g)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 374 18 "No. 87. Procedur e " }{TEXT 415 8 "clisolve" }{TEXT 416 103 " for solving equations in \+ a Clifford algebra Cl(B). \n\nTypical use:\n\nclisolve(eq,pp);\nclisol ve(eq,set);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 594 "clisolve:=proc(eq ::\{clibasmon,climon,clipolynom\},indet::\{list,algebraic\}) \nlocal i ,T,vars,sol,sys;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revis ed: September 17, 2005`;\n############################################ #\nif type(indet,list) then\n vars:=convert(indet,set)\nelse\n vars: =select(type,indets(indet),indexed)\nend if;\nT:=cliterms(eq);\nsys:= \{coeffs(clicollect(simplify(eq)),T)\};\nsol:=[solve(sys,vars)];\nif t ype(indet,list) then\n return sol\nelse\n return [seq(subs(sol[i],in det),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 ar e loaded.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6580 "CLIFFORD_ENV:=proc () global _warnings_flag:\noptions `Copyright (c) 1995-2005 by Rafal A blamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `L ast revised: September 17, 2005`;\n################################### ##########\nif not assigned(Clifford) then \n lprint(`>>> Package Cl ifford has not been loaded yet. Type 'with(Clifford)' at the Maple pro mpt to load it first. <<<`)\nelse\n print('``');###Print blank line\n \+ lprint(`>>> Global variables defined in Clifford:-setup are now availa ble and have these values: <<<`);\nlprint(`************* Start ******* ******`); \n########################\nlprint('dim_V'=dim_V);\n #(d imension of the carrier space for Cl(V,B))\nif not member(dim_V,\{1,2, 3,4,5,6,7,8,9\}) and _warnings_flag then\n lprint(`Warning, value of dim_V is expected to be a positive integer between 1 and 9, inclusive .`);\n print('``');###Print blank line\nend if;\n################### #####\nlprint('_default_Clifford_product'=_default_Clifford_product); \n #(controls whether cmulRS or cmulNUM is used in Clifford produ ct 'cmul')\n#lprint(`Possible values are: 'cmulRS','cmulNUM','cmulgen' ,'cmul_user_defined'.`);\nif not member(_default_Clifford_product,\{'c mulRS','cmulNUM','cmulgen','cmul_user_defined'\}) \n and _warnings_f lag then\n lprint(`****** SERIOUS WARNING ******`); \n lprint(`>>> Value of _default_Clifford_product was expected to be 'cmulRS', 'cmul NUM', 'cmulgen', or 'cmul_user_defined'. <<<`);\n lprint(`********** *******************`);\nend if;\n########################\nlprint('_pr olevel'=_prolevel);\n #(controls whether or not parsing is done) \nif not member(_prolevel,\{true,false\}) and _warnings_flag then\n \+ lprint(`Warning, 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 \+ #(controls flow in procedure 'minimalideal')\nif not member(_short cut_in_minimalideal,\{true,false\}) and _warnings_flag then\n lprint (`Warning, value of _shortcut_in_minimalideal is expected to be true o r false.`);\n print('``');###Print blank line\nend if;\n############ ############\nlprint('_shortcut_in_Kfield'=_shortcut_in_Kfield);\n \+ #(controls flow in procedure 'Kfield')\nif not member(_shortcut_in_K field,\{true,false\}) and _warnings_flag then\n lprint(`Warning, val ue of _shortcut_in_Kfield is expected to be true or false.`);\n prin t('``');###Print blank line\nend if;\n########################\nlprint ('_shortcut_in_spinorKbasis'=_shortcut_in_spinorKbasis);\n #(cont rols flow in procedure 'spinorKbasis')\nif not member(_shortcut_in_spi norKbasis,\{true,false\}) and _warnings_flag then\n lprint(`Warning, value of _shortcut_in_spinorKbasis is expected to be true or false.`) ;\n print('``');###Print blank line\nend if;\n###################### ##\nlprint('_shortcut_in_spinorKrepr'=_shortcut_in_spinorKrepr);\n \+ #(controls flow in procedure 'spinorKrepr')\nif not member(_shortcut _in_spinorKrepr,\{true,false\}) and _warnings_flag then\n lprint(`Wa rning, value of _shortcut_in_spinorKrepr is expected to be true or fal se.`);\n print('``');###Print blank line\nend if;\n################# #######\nlprint('_warnings_flag'=_warnings_flag);\n #(controls wh ether some procedures, e.g., 'wedge', give warnings)\nif not member(_w arnings_flag,\{true,false\}) then\n lprint(`Warning, value of _warni ngs_flag is expected to be true or false.`);\n print('``');###Print \+ blank line\nend if;\n########################\nlprint('_scalartypes'=_ scalartypes);\n #(defines types considered to be 'scalars' by 'cl ibilinear' and 'clilinear')\n########################\nlprint('_quatba sis'=_quatbasis);\n #(defines default quaternionic basis')\nlprin t(`************* End *************`);\nprint('``');###Print blank line \nend if;\n########################\nif assigned(Cliplus) then\n prin t('``');###Print blank line\n lprint(`>>> Global variables defined in \+ Cliplus:-setup are now available and have these values: <<<`);\n lpri nt(`************* 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('ma cro(`&c`=climul)');\n #('&c' is now extended by 'climul')\n lprin t('macro(`&cQ`=climul)');\n #('&cQ' is now extended by 'climul') \n lprint('macro(reversion=clirev)');\n #('reversion' is now exte nded by 'clirev')\n lprint('macro(LC=LCbig)');\n #('LC' is now ex tended by 'LCbig')\n lprint('macro(RC=RCbig)');\n #('RC' is now e xtended by 'RCbig')\n if _warnings_flag then \n lprint(`Warning, n ew definitions for type/climon and type/clipolynom now include &C`);\n end if;\n lprint(`************* End *************`);\n print('``');## #Print blank line \nend if;\n\n####################################### #############\n### Executable Bigebra file for Maple 6 is Bigebra6\n## ##################################################\nif assigned(Bigebr a6) then\n print('``');###Print blank line\n lprint(`>>> Global variab les defined in Bigebra:-init are now available and have these values: \+ <<<`);\n lprint(`************* Start *************`);\n lprint('_CLIE NV[_SILENT]'=_CLIENV[_SILENT]); #controls messaging upon starting 'Bi gebra'\n lprint('_CLIENV[_QDEF_PREFACTOR]'=_CLIENV[_QDEF_PREFACTOR]); \+ #prefactor in 'switch'\n lprint(`************* End *************`);\n print('``');###Print blank line\nend if;\n########################### ###############\nif assigned(GTP) then\n print('``');###Print blank li ne\n lprint(`************* Start *************`);\n lprint(`>>> There \+ are no new global variables or macros in GTP yet. <<<`);\n lprint(`*** ********** End *************`);\n print('``');###Print blank line \nen d if;\n##########################################\nif assigned(Octonio n) then\n print('``');###Print blank line\n lprint(`>>> Global variabl es defined in Octonion:-setup are now available and have these values: <<<`);\n print('``');###Print blank line\n lprint(`************* Sta rt *************`); \n lprint('_octbasis'=_octbasis); #stand ard octonion basis as Maple global variable\n lprint('_pureoctbasis'=_ pureoctbasis); #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 squar es of e1,e2,e3,e4,e5,e6,e7\n lprint('_default_Clifford_product'=_defau lt_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 "makeclibasmon" }{TEXT 419 402 " that takes a list and makes Grassm ann basis monomials. It is expected, that the list contains positive i ntegers between 1 and 9 inclusive, or symbolic indices consisting of o ne-character strings. If the list is empty, then Id is returned. If an y two elements in the list are peated, then 0 is returned. This proced ure has a remember table.\n\nTypical use: makeclibasmon([]); makecliba smon([1,7,i,j,3]);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 475 "makeclibas mon:=proc(x::list) \nlocal result,N,i;\noptions `Copyright (c) 1995-20 05 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`,rem ember;\ndescription `Last revised: September 17, 2005`;\n############# ################################\n N:=nops(x);\n if N = 0 then retur n Id end if;\n if N > nops(convert(x,set)) then return 0 end if;\n \+ result:=cat(e,x[1]);\n for i from 2 to N do\n result:=cat(res ult,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 without any arguments in which case default values are used in ternally, or with 1 or 2 arguments as follows:\n\nNT1 = maximum allowe d index value (default 9)\nNT2 = maximum allowed grade (default 4)\n\n rd_clibasmon(); then NT1 = 9, NT2 = 4 \nrd_clibasmon(a1); \+ then NT1 = a1, NT2 = 4\nrd_clibasmon(a1,a2); then NT1 = a1, NT 2 = a2\n\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1405 "rd_clibasmon:=proc () local ind,NT1,NT2,nt1d,nt2d,L;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescri ption `Last revised: September 17, 2005`;\n########################### ##################\n### NT1 = maximum allowed index value (default 9) \n### NT2 = maximum allowed grade (default 4) (must be less than or eq ual to NT1)\nnt1d,nt2d:=9,4:\n######################################## #####\nif nargs=0 then\n NT1,NT2:=nt1d,rand(0..nt2d)(): #defaults\n \+ L:=[[]]:\nelif nargs=1 then\n if not type(args[1],nonnegint) or no t evalb(args[1]<=9 and args[1]>= 0) then\n error \"argument must \+ be non negative integer between 0 and 9 giving the maximum monomial in dex\"\n end if;\n NT1,NT2:=args[1],rand(0..args[1])():\n L:=[[]] : \n elif nargs>=2 then\n if evalb(not type([args],list(nonnegi nt)) or \n not evalb(args[1]<=9 and args[1]>=0) or\n not eva lb(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 between 0 and first arg ument giving 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))];\nind:=sort(L[rand(1..nops(L))()]);\nreturn Clifford:-makeclib asmon(ind)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. 91. Proced ure " }{TEXT 475 9 "rd_climon" }{TEXT -1 560 " generates a random Gras smann monomial. It can be used without any arguments in which case def ault values are used internally, or with 1, 2, or 3 arguments as follo ws:\n\nNT1 = maximum allowed index value (default 9)\nNT2 = maximum al lowed grade (default 4)\nNT3 = maximum absolute value of coefficients \+ allowed (default 12)\n\nrd_climon(); then NT1 = 9, NT2 = 4, NT3 = 12 \nrd_climon(a1); then NT1 = a1, NT2 = 4, NT 3 = 12\nrd_climon(a1,a2); then NT1 = a1, NT2 = a2, NT3 = 12\nrd _climon(a1,a2,a3); then NT1 = a1, NT2 = a2, NT3 = a3\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1994 "rd_climon:=proc() local rcf,NT1,NT2,NT3,nt1 d,nt2d,nt3d;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: \+ September 17, 2005`;\n#############################################\n# ## NT1 = maximum allowed index value (default 9)\n### NT2 = maximum al lowed grade (default 4)\n### NT3 = maximum absolute value of coefficie nt allowed (default 12)\nnt1d,nt2d,nt3d:=9,4,12:\n#################### #########################\nif nargs=0 then\n NT1,NT2,NT3:=nt1d,rand( 0..nt2d)(),rand(1..nt3d)(): #defaults\nelif nargs=1 then\n if not ty pe(args[1],nonnegint) or not evalb(args[1]<=9 and args[1]>= 0) then\n \+ error \"argument must be non negative integer between 0 and 9 giv ing 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(n ot type([args],list(nonnegint)) or \n not evalb(args[1]<=9 \+ and args[1]>=0) or\n not evalb(args[2]<=args[1] and args[2] >=0)) then\nerror \"first argument must be non negative integer betwee n 0 and 9 giving maximum monomial index. Second argument must be non n egative integer between 0 and first argument giving maximum possible g rade.\"\n end if;\n NT1,NT2,NT3:=args[1],min(args[1],args[2]),rand (1..nt3d)():\nelif nargs>=3 then\n if evalb(not type([args],list(non negint)) 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 \"fir st argument must be non negative integer between 0 and 9 giving maximu m monomial index. Second argument must be non negative integer between 0 and first argument giving maximum possible grade. Third argument mu st be a positive integer giving max value of coefficient. Other argume nts, if present, are ignored.\"\n end if;\n NT1,NT2,NT3:=args[1],m in(args[1],args[2]),args[3]:\nend if:\n#############\nrcf:=[rand(-NT3. .-1)(),rand(1..NT3)()]:\nrcf:=rcf[rand(1..nops(rcf))()];\nreturn rcf*r d_clibasmon(NT1,NT2)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT -1 18 "No. \+ 92. Procedure " }{TEXT 476 13 "rd_clipolynom" }{TEXT -1 761 " generate s a random Grassmann polynomial. It can be used without any arguments \+ in which case default values are used internally, or with 1, 2, 3, or \+ 4 arguments as follows:\n\nNT1 = maximum allowed index value (default \+ 9)\nNT2 = maximum allowed grade (default 4)\nNT3 = maximum absolute va lue of coefficients allowed (default 12)\nNT4 = maximum number of ter ms allowed (default 4)\n\nrd_clipolynom(); then N T1 = 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_clipolyn om(a1,a2,a3,a4); then NT1 = a1, NT2 = a2, NT3 = a3, NT4 = a4\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 3537 "rd_clipolynom:=proc() \nlocal rnt ,rcf,NT1,nt1d,NT2,nt2d,NT3,nt3d,NT4,nt4d,L,newL,i,inde,x,m;\noptions ` Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n# ############################################\n### NT1 = maximum allowe d index value (default 9)\n### NT2 = maximum allowed grade (default 4) (must be leq. than NT1)\n### NT3 = maximum absolute value of coeffici ent allowed (default 12)\n### NT4 = maximum number of terms allowed (d efault 5)\nnt1d,nt2d,nt3d,nt4d:=9,4,12,5:\n########################### ##########################\nif nargs=0 then\n NT1,NT2,NT3,NT4:=\n \+ nt1d,rand(0..nt2d)(),rand(1..nt3d)(),rand(1..nt4d)(): #defaults\nelif \+ nargs=1 then\n if not type(args[1],nonnegint) or not evalb(args[1]<= 9 and args[1]>= 0) then\n error \"argument must be non negative i nteger between 0 and 9 giving the maximum monomial index\"\n end if; \n NT1,NT2,NT3,NT4:=args[1],rand(0..args[1])(),\n \+ rand(1..nt3d)(),rand(1..nt4d)():\nelif nargs=2 then\nif evalb(not typ e([args],list(nonnegint)) or \n not evalb(args[1]<=9 and ar gs[1]>=0) or\n not evalb(args[2]<=args[1] and args[2]>=0)) \+ then\nerror \"first argument must be non negative integer between 0 an d 9 giving maximum monomial index. Second argument must be non negativ e integer between 0 and first argument giving maximum possible grade. \"\n end if;\n NT1,NT2,NT3,NT4:=args[1],rand(0..min(args[1],args[2 ]))(),\n rand(1..nt3d)(),rand(1..nt4d)(): \nelif n args=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(ar gs[2]<=args[1] and args[2]>=0)) then\nerror \"first argument must be n on negative integer between 0 and 9 giving maximum monomial index. Sec ond argument must be non negative integer between 0 and first argument giving maximum possible grade. Third argument must be a positive inte ger giving max value of coefficient.\";\n end if;\n NT1,NT2,NT3,NT 4:=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],l ist(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\nerro r \"first argument NT1 must be non negative integer between 0 and 9 gi ving maximum monomial index. Second argument NT2 must be non negative \+ integer between 0 and NT1 (inclusive) giving maximum possible grade. T hird argument NT3 must be a positive integer giving max value of coeff icient. Fourth argument NT4 must be a positive integer giving maximum \+ number of terms (it is expected to be no larger that number of combina tions NT1 choose NT2. Other arguments, if present, are ignored.\"\n \+ end if:\n NT1,NT2,NT3,NT4:=args[1],min(args[1],args[2]),args[3],args [4]:\nend if:\n#############\n### NT1 = maximum allowed index value (d efault 9)\n### NT2 = maximum allowed grade (default 5)\n### NT3 = maxi mum absolute value of coefficient allowed (default 12)\n### NT4 = maxi mum number of terms allowed (default 4)\n#############\nL:=\{\}:\nfor \+ i from 0 to NT2 do\n L:=\{op(L),op(combinat[choose](NT1,i))\};\nend do:\nm:=min(nops(L),NT4):\nL:=convert(L,list):\nnewL:=[[],[[]]]:\nnew L:=newL[rand(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=NU LL,L);\nend do;\nL:=map(makeclibasmon,newL);\nrcf:=[rand(-NT3..-1)(),r and(1..NT3)()]:\nreturn add(rcf[rand(1..nops(rcf))()]*L[i],i=1..nops(L ))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 33 "No. 93. Initializati on procedure " }{TEXT 420 5 "setup" }{TEXT -1 26 " for the Clifford pa ckage." }}{PARA 258 "" 0 "" {TEXT -1 0 "" }}{PARA 258 "" 0 "" {TEXT -1 94 "This package is loaded automatically into Maple session when co mmand with(Clifford); is given." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1634 "setup:=proc() \nlocal x,y,i,j;\ng lobal libname,B,\n_quatbasis,qi,qj,qk,\n_prolevel,\n_shortcut_in_minim alideal,\n_shortcut_in_Kfield,\n_shortcut_in_spinorKbasis,\n_shortcut_ in_spinorKrepr,\ndim_V,\n_warnings_flag,\n_scalartypes,\n_CLIENV,\n_de fault_Clifford_product,\npause,\n###################################\n `convert/dfmatrix`,`convert/mlist`,`convert/str_to_int`,`type/clibasmo n`,\n`type/antisymmatrix`,`type/climatrix`,`type/climon`,`type/clipoly nom`,\n`type/cliprod`,`type/cliscalar`,`type/dfmatrix`,`type/diagmatri x`, `type/evenelement`,`type/fieldelement`,`type/gencomplex`,`type/gen quatbasis`,\n`type/genquaternion`,`type/idempotent`,`type/nilpotent`,` type/oddelement`,\n`type/primitiveidemp`,`type/purequatbasis`,`type/qu aternion`,\n`type/symmatrix`,`type/tensorprod`,\n`&c`,`&cQ`,`&cQm`,`&c m`,`&om`,`&q`,`&qm`,`&rm`,`&w`,`&wm`;\n############################### ####\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfri ed Fauser. All rights reserved.`;\ndescription `Last revised: Septembe r 17, 2005`;\n######################################################## #\n_prolevel:=false: #assigning default value\n_shortcu t_in_minimalideal:=true: #assigning default value\n_shortcut_in_Kfield :=true: #assigning default value\n_shortcut_in_spinorKbasis:=tru e: #assigning default value\n_shortcut_in_spinorKrepr:=true: #assigni ng default value\n_warnings_flag:=true: #assigning default \+ value\ndim_V:=9: #default value\n_scalartypes:= \{RootOf,mathfunc,function,numeric,rational,constant,indexed,complex,` ^`\}:\n_CLIENV[_QDEF_PREFACTOR]:=-1:\n_default_Clifford_product:=cmulR S: #default Clifford product\n" }}{PARA 0 "" 0 "" {TEXT 371 98 "(1) Gl obal variable _scalartypes contains all types declared by the user to \+ be of type 'scalar'. \n" }}{PARA 258 "" 0 "" {TEXT -1 303 "(2) Standar d quaternion basis as Maple global variable as in P. Lounesto \"Cliffo rd Algebras and Spinors\", page 49. To avoid conflicts with i, j, k, \+ etc. traditionally used in summations, loops, user could define qi, qj , and qk in place of \{i, j, k\} used to denote pure quaternion part o f 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 abbreviat ions for quaternion basis:" }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 "unprotect(qi,qj,qk);\nqi:=-e2we3:\nqj:=e1we3:\nqk:=-e 1we2:\n" }}{PARA 0 "" 0 "" {TEXT 368 31 "(4) Defining useful functions :\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 "pause:=proc(s::nonnegint) lo cal s1:\ns1:=time():\nwhile time()-s1 < s do od end proc:" }}{PARA 0 " " 0 "" {TEXT 369 37 "\n(5) Protecting all procedure names:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 "protect(Clifford,e,'qi','qj','qk',Id,w); \n" }}{PARA 258 "" 0 "" {TEXT 473 22 "Types and conversions:" }{TEXT -1 32 "\n\nNo. 1. Definition of the type " }{TEXT 436 9 "clibasmon" } {TEXT -1 87 ", i.e., a basis monomial. \n\nTypical use: type(e2we1,cli basmon); type(e1we2,clibasmon);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 947 "`type/clibasmon`:=proc(a)\nlocal a1,i,str,lst,e_set,w_set,ind_lst ,N;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: September 17, 2005`;\n#############################################\n#a1:=simpl ify(eval(a)):\na1:=eval(a): #no simplify here\n if a1 = Id then retu rn true end if:\n if type(a1,\{string,name,symbol\}) then\n str: =convert(a1,string);\n lst:=[seq(str[i],i=1..length(a1))];\n N :=(nops(lst)+1)/3;\n if N=1 then \n e_set:=\{lst[1]\};\n \+ w_set:=\{\"w\"\};\n ind_lst:=[lst[2]];\n else\n e_s et:=\{seq(lst[3*i-2],i=1..N)\};\n w_set:=\{seq(lst[3*i],i=1..N-1 )\};\n ind_lst:=[seq(lst[3*i-1],i=1..N)];\n end if:\n# print (e_set,w_set,ind_lst,N,lst);\n if (e_set=\{\"e\"\}) and (w_set=\{ \"w\"\}) and (N=nops(\{op(ind_lst)\})) then\n return true\n \+ 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. D efinition of the type " }{TEXT 437 9 "cliscalar" }{TEXT -1 255 ", i.e. , Clifford scalar. A Clifford scalar is essentially any number, functi on, constant, or an algebraic expression not containing any basis mono mials (this means that 2*Id is not of type 'cliscalar').\n\nTypical us e: type(e1+e2we3+2*Pi*B[1,2],cliscalar);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 765 "`type/cliscalar`:=proc(a::anything) local a1,locscal artypes;\nglobal `&C`,_scalartypes; \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndes cription `Last revised: September 17, 2005`;\n######################## #####################\na1:=simplify(eval(a)):\nlocscalartypes:=remove( member,_scalartypes,\{`^`\}):\nif type(a1,\{matrix,list\}) or hastype( a1,clibasmon) or \n hastype(a1,tensorprod) or has(a1,`&C`) then retu rn false \nend if: \nif type(a1,locscalartypes) or evalb(op(map(type, \{op(a1)\},locscalartypes))=true)\n then return true \nend if:\nif \+ type(a1,`^`) then\n if select(hastype,\{a1\},clibasmon)=\{\} then\n \+ return true else error \"illegal expression in %1\",a1 \n end i f:\nend if:\nreturn cliparse(a1)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 31 "No. 3. Definition of the type " }{TEXT 438 6 "climon" } {TEXT -1 197 ", i.e., Clifford monomial. A Clifford monomial is essent ially any basis monomial (of type 'clibasmon') multiplied by a Cliffor d scalar (of type 'cliscalar').\n\nTypical use: type(e1we2+2*e2,climon );\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 763 "`type/climon`:=proc(x1) lo cal x,S,xx,flag6plus:\noptions `Copyright (c) 1995-2005 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: September 17, 2005`;\n####################################### ######\nx:=simplify(eval(x1)):\nflag6plus:=assigned(Cliplus):\nif hast ype(x,cliprod) and not flag6plus and _warnings_flag then \n WARNING( `argument to 'type/climon' contains type 'cliprod'. Load 'Cliplus' to \+ extend functionality of CLIFFORD. Type ?cliprod for help.`);\nend if: \n##################\nif not flag6plus then S:=\{'clibasmon'\} else S: =\{'clibasmon','cliprod'\} end if:\nxx:=simplify(x):\nif type(xx,clisc alar) then false\nelif evalb(type(xx,`*`) and nops(select(type,\{op(xx )\},S))=1) then\n true \nelse \n false\nend if:\nend proc:\n" }} {PARA 258 "" 0 "" {TEXT -1 30 "No. 4. Definition of the type " }{TEXT 439 10 "clipolynom" }{TEXT -1 265 ", i.e., Clifford polynomial. A Cli fford polynomial is a multivariate polynomial in the unknowns of type \+ 'climon' or 'cliprod', i.e., Clifford monomial, with coefficients of t he type 'cliscalar', i.e., Clifford scalar.\n\nTypical use: type(e1+2* Pi*e2we3,clipolynom);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 981 "`type/c lipolynom`:=proc(x1) local x,flag6plus:\noptions `Copyright (c) 1995-2 005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\n description `Last revised: September 17, 2005`;\n##################### ########################\n#x:=simplify(eval(x1)):\nx:=eval(x1): #no so mplify here\nif type(eval(x),\{matrix,list,set,cliscalar\}) or \n \+ (not type(eval(x),algebraic)) or \n hastype( eval(x),tensorprod) then \nreturn false \nend if:\nflag6plus:=assigne d(Cliplus):\nif hastype(x,cliprod) and not flag6plus and _warnings_fla g then \n WARNING(`argument to 'type/clipolynom' contains type 'clip rod'. Load 'Cliplus' to extend functionality of CLIFFORD. Type ?clipr od for help.`);\nend if:\nif evalb(not flag6plus and type(expand(x),`+ `) and hastype(x,clibasmon) and not hastype(x,cliprod)) \n then retu rn true \nend if:\nif evalb(flag6plus and type(expand(x),`+`) and has type(x,\{clibasmon,cliprod\})) then \n return true \nend if: \nretu rn 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 appr opriate digit.\n\nTypical use: map(convert,extract(e1we2),str_to_int); \n" }{MPLTEXT 0 21 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 647 "`convert /str_to_int`:=proc(a1::symbol)\noptions `Copyright (c) 1995-2005 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`,remember;\n description `Last revised: December 2, 2002`;\nreturn parse(a1);\n#### #########################################\nif args[1] = `0` then retur n 0 elif\n args[1] = `1` then return 1 elif\n args[1] = `2` then r eturn 2 elif\n args[1] = `3` then return 3 elif\n args[1] = `4` th en return 4 elif\n args[1] = `5` then return 5 elif\n args[1] = `6 ` then return 6 elif\n args[1] = `7` then return 7 elif\n args[1] \+ = `8` then return 8 elif\n args[1] = `9` then return 9 else\n retu rn a1\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 6. D efinition of type " }{TEXT 442 9 "nilpotent" }{TEXT -1 914 ". The fol lowing procedure verifies whether or not its non-zero argument is a ni lpotent element in the given Clifford algebra Cl(B). It is expected t hat a matrix of the bilinear form B has been specified. If the eleme nt happens to be an idempotent, or if some power of that element equal s the element itself, or if the element is of type 'cliscalar' then th e 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 lis t is the element to be checked for nilpotency. \n\nTypical use: type( (1/2)*(e1 +e1we3),nilpotent); #this is a nilpotent element in Cl(3,0) \ntype(p,nilpotent);\ntype([p,K],nilpotent);\ntype([p,-K],nilpotent); \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2105 "`type/nilpotent`:=proc(a11) \nlocal a1,i,x,y,xx,k,flagB,S,lname,flagindexed;global B;\noptions `C opyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`;\ndescription `Last revised: September 17, 2005`;\n## ###########################################\n######################### #################\n##This code allows for passing name of the matrix K as a second element in a list:\n##To test element p for nilpotency w. r.t. matrix K enter [p,K];\n##To test element p for nilpotency w.r.t. \+ B enter p, or, [p,B].\n##########################################\nif \+ type(a11,\{cliscalar,clibasmon,climon,clipolynom\}) then\n a1:=a11: \n lname:=`B`:\n flagindexed:=false:\n if not type(B,matrix) \+ then error \"matrix must be assigned to B\" \n else flagB:= type(B,diagmatrix) \n end if:\nelif type(a11,list) then\n if no ps(a11)<>2 then error \"list must have exactly two elements\"\n e lif not type(a11[1],\{cliscalar,clibasmon,climon,clipolynom\}) or\n \+ not type(a11[2],\{name,symbol,matrix,array,`&*`(numeric,\{name ,symbol,matrix,array\})\})\n then error \"list must contain clipo lynom and name\"\n else\n a1:=a11[1]:\n lname:=a11[2]:\n flagi ndexed:=true:\n if not type(evalm(lname),matrix) then error \"mat rix must be assigned to %1\",lname \n else flagB:=type(eval m(lname),diagmatrix) \n end if: \n end if:\nelse\n error \"un expected argument type\"\nend if:\n################################### \nx:=displayid(a1):\nif a1=0 then return true \n elif type(a1,clisc alar) then \n return false \n elif (type(x,clibasmon) a nd flagB and linalg[det](evalm(lname))<>0) then \n return \+ false \nend if:\n####################################\nxx:=cmul[lname ](x,x):\nif evalb(xx=0) then return true end if:\nif evalb(simplify(xx -x)=0) or not evalb(solve(xx=k*x,k)=NULL) then return false end if:\ny :=xx:\nfor i from 1 to 2^maxindex(a1) do\n if y=vectorpart(y,0) \+ or y=x then return false end if: \n y:=cmul(x,y);\n if y= 0 then return true end if:\n end do:\nerror \"Sorry, but I am un able to determine nilpotency of %1\",a1\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 7. Definition of type " }{TEXT 443 10 "idempoten t" }{TEXT -1 311 ". The following procedure verifies whether or not i ts argument is an idempotent in the given Clifford algebra Cl(B). It \+ is expected that a matrix of the bilinear form B has been specified. I t can also check element p for being idempotent in Cl(K) if K is enter ed as a second argument in a list such as [p,K].\n" }}{PARA 0 "" 0 "" {TEXT 431 124 "Typical use: type((1/2)*(1 + e1),idempotent); #this is an idempotent in Cl(3,0)\ntype(p,idempotent);\ntype([p,K],idempotent) ;" }}{PARA 0 "" 0 "" {TEXT 435 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1579 "`type/idempotent`:=proc(a11) \nlocal f,ff,lname,a1,flagindexed,f lagB; global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: September 17, 2005`;\n############################################# \n##########################################\n##This code allows for p assing name of the matrix K as a second element in a list:\n##To test \+ element p for being idempotent w.r.t. matrix K enter [p,K];\n##To test element p for being idempotent w.r.t. B enter p, or, [p,B].\n######## ##################################\nif type(a11,\{cliscalar,clibasmon, climon,clipolynom\}) then\n a1:=a11:\n lname:=`B`:\n flagindexed :=false:\n if not type(B,matrix) then error \"matrix must be assi gned to B\" \n else flagB:=type(B,diagmatrix) \n end i f:\nelif type(a11,list) then\n if nops(a11)<>2 then error \"list mus t have exactly two elements\"\n elif not type(a11[1],\{cliscalar, clibasmon,climon,clipolynom\}) or\n not type(a11[2],\{name,s ymbol,matrix,array,`&*`(numeric,\{name,symbol,matrix,array\})\})\n \+ then error \"list must contain clipolynom and name\"\n else\n a1 :=a11[1]:\n lname:=a11[2]:\n flagindexed:=true:\n if not type (evalm(lname),matrix) then error \"matrix must be assigned to %1\",lna me \n else flagB:=type(evalm(lname),diagmatrix) \n end if: \n end if:\nelse\n error \"unexpected argument type\"\nend if :\n########################################\nf:=displayid(a1):\nff:=cm ul[lname](f,f):\nif evalb(ff=0) then return false end if:\nreturn eval b(simplify(ff-f)=0)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 8. A new type " }{TEXT 444 9 "climatrix" }{TEXT -1 424 " is a matrix \+ with at least one entry of type 'clipolynom'. Note that anything in Ma ple that has been defined via the procedure linalg[matrix] is of the s tandard Maple type 'matrix' including matrices with entries in a Cliff ord algebra. Since a matrix with numerical entries is not of the type \+ 'climatrix', this procedure allows one to distinguish such matrix from those that do have at least one entry in a Clifford algebra." }} {PARA 258 "" 0 "" {TEXT -1 208 "\nMatrices of the type 'matrix' but no t 'climatrix' may be multiplied using standard Maple matrix multiplica tion operator `&*`.\n\nMatrices of the type 'climatrix' must be multip lied using the procedure 'rmulm'." }}{PARA 0 "" 0 "" {TEXT 430 104 "\n Typical use: M:=linalg[matrix](2,2,[e1,e3we4+e3,e4,Id-e1]);\n \+ type(M,climatrix);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 357 "`type/climatrix`:=proc(x)\noptions `Copyright (c) 1995-2005 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: September 17, 2005`;\n############################## ###############\nif type(x,array) then\n return evalb(select(type,con vert(x,set),\{clipolynom,climon,clibasmon\})<>\{\})\nelse \n return f alse\nend if:\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 429 37 "No. 9. Use ful conversion function to " }{TEXT 445 5 "mlist" }{TEXT 446 20 " need ed by 'rmulm'.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 370 "`convert/mlist `:=proc(a1::matrix) local i,longlist;\noptions `Copyright (c) 1995-200 5 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: September 17, 2005`;\n####################### ######################\nlonglist:=[]:\nfor i from 1 to linalg[rowdim]( a1) do\nlonglist:=[op(longlist),op(convert(linalg[row](a1,i),list))] o d\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 428 19 "No. 10. A new type " } {TEXT 447 12 "fieldelement" }{TEXT 448 2 ":\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 549 "`type/fieldelement`:=proc(a1::algebraic) global f; \+ \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: September 17 , 2005`;\n#############################################\nif not assign ed(f) then \n error \"primitive idempotent f has not been assigned y et\" \nend if:\nif not type(f,primitiveidemp) then \n error \"althou gh f has been assigned, it is not of type/primitiveidemp\"\nend if:\ni f 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 m atrix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 471 "`type/symmatrix`:=proc (a1::\{name,symbol,matrix,`&*`(algebraic,matrix)\}) \noptions `Copyrig ht (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights \+ reserved.`;\ndescription `Last revised: September 17, 2005`;\n######## #####################################\nif evalb(evalm(a1)=a1) then ret urn false end if:\nif linalg[coldim](a1)<>linalg[rowdim](a1) then\n \+ error \"B must be assigned square matrix\" \nend if:\nreturn linalg[eq ual](a1,linalg[transpose](a1))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 426 20 "No. 12. A new type: " }{TEXT 451 13 "antisymmatrix" }{TEXT 452 31 " - an anti-symmetric matrix:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 476 "`type/antisymmatrix`:=proc(a1::\{name,symbol,matrix, `&*`(algebraic,matrix)\}) \noptions `Copyright (c) 1995-2005 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: September 17, 2005`;\n################################## ###########\nif evalb(evalm(a1)=a1) then return false end if:\nif lina lg[coldim](a1)<>linalg[rowdim](a1) then\n error \"B must be assigned square matrix\" \nend if:\nreturn linalg[equal](a1,-linalg[transpose] (a1))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 425 20 "No. 13. A new type : " }{TEXT 453 10 "diagmatrix" }{TEXT 454 25 " - a diagonal matrix. \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 484 "`type/diagmatrix`:=proc(a1:: anything) local N,i,DD;\noptions `Copyright (c) 1995-2005 by Rafal Abl amowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Las t revised: September 17, 2005`;\n##################################### ########\nif not type(a1,\{matrix,`&*`(algebraic,matrix)\}) then retur n false end if:\nif not type(a1,symmatrix) then return false end if:\n N:=linalg[coldim](a1):\n DD:=linalg[diag](seq(a1[i,i],i=1..N)):\n \+ return linalg[iszero](evalm(a1-DD))\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 18 "No. 14. New type: " }{TEXT 455 14 "primitiveidemp" } {TEXT -1 1109 " - primitive idempotent. This procedure determines the number of factors in the given idempotent of the type (1/2)*(Id+e[i]) , i=1..n, where \{e[i],i=1..n\} is a set of commuting basis monomials \+ with square equal to 1 mod Id. \nIt returns 'true' if n = q - RHnumbe r(q-p), where 'RHnumber' is the Radon-Hurwitz function and [p,q] is si gnature of the current quadratic form which is assumed to have been de fined, i.e., the bilinear form B has been defined as a diagonal matrix , and 'false' if n < q - RHnumber(q-p).\n\nIf the argument is the iden tity element 'Id' of the algebra Cl(Q), the procedure checks if Cl(Q) \+ is simple or semi-simple, and it returns 'true' or 'false' respectivel y. It is known that when Cl(Q) is semi-simple, 'Id' can be written as a sum of mutually annihilating idempotents (1/2)*(Id+p) and (1/2)*(Id -p), where p is the unit pseudo-scalar element (volume element) in Cl( Q).\n\nThe procedure expects that the bilinear form B has been defined as a diagonal matrix.\n\nTypical use: type(cmul((1/2)*(Id+e1),(1/2)*( Id+e2we3we4we5),primitiveidemp);\n type(Id,pri mitiveidemp);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 510 "`type/primitive idemp`:=proc(f::idempotent) local p,q,numfact;global B;\noptions `Copy right (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All righ ts reserved.`;\ndescription `Last revised: September 17, 2005`;\n##### ########################################\nif not type(B,matrix) then \+ \n error \"B must be assigned square matrix\" \nelse\n p:=Bsignatu re(B)[1]:q:=Bsignature(B)[2]\nend if:\nnumfact:=q-RHnumber(q-p):\nif s calarpart(f)=1/2^numfact then \n return true \nelse \n return fals e \nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 13 "No. 15. Typ e " }{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 922 "`type/pureq uatbasis`:=proc(l1::list(\{clibasmon,climon,clipolynom\})) \nlocal p,q ,r;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: \+ September 17, 2005`;\n#############################################\ni f nops(l1) <> 3 then \n error \"list must have exactly 3 elements of type 'clibasmon', 'climon', or 'clipolynom' but received a list with \+ %1 elements\",nops(l1)\nend if:\nif not type(B,matrix) then \n error \"square matrix must be assigned to B\"\nend if: \np:=l1[1]:q:=l1[2]: r:=l1[3]:\nif cmul(p,p)<>-Id then return false elif\n cmul(q,q)<>-Id 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)+cm ul(q,p)<>0 then return false elif\n cmul(p,r)+cmul(r,p)<>0 then retu rn false elif\n cmul(q,r)+cmul(r,q)<>0 then return false else\n re turn true\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "No. \+ 16. A new type: " }{TEXT 457 10 "gencomplex" }{TEXT -1 413 " - a gener alized complex element of Cl(B). A Clifford polynomial p in Cl(B) is \+ of this type if it belongs to a subalegbra A of Cl(B) isomorphic to co mplex numbers C. Knowing that the given polynomial p is of that type a llows for finding the inverse of p in A < Cl(B) a more efficient way b y the procedure 'cinv'.\n\nNote that elements of grade 0 (eg., 2*Id) a re not of this type.\n\nTypical use: type(p,gencomplex);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 888 "`type/gencomplex`:=proc(a1::\{cliscalar,cl ibasmon,climon,clipolynom\}) local L;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserv ed.`;\ndescription `Last revised: September 17, 2005`;\n############## ###############################\nif not type(B,matrix) then \n error \"can't check type since B is not assigned a matrix\" \nend if:\nif t ype(a1,cliscalar) then return false end if:\nL:=[op(cliterms(reorder(a 1)))];\nif nops(L)>2 then return false end if:\nif nops(L)=1 and L=[Id ] then return false end if:\nif nops(L)=2 and not member(Id,L) then re turn false end if:\nL:=remove(member,L,[Id]);\nif maxindex(L)>linalg[c oldim](B) then \n error \"can't check type since the largest index i n %1 is greater than size %2 of current form B\", a1,linalg[coldim](B) \nend if:\nif cmul(L[1],L[1])=-Id then \n return true \nelse \n re turn false \nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 20 "N o. 17. A new type: " }{TEXT 458 13 "genquaternion" }{TEXT -1 513 " - a generalized quaternionic element of Cl(B). A Clifford polynomial p i n Cl(B) is of this type if it belongs to a subalegbra A of Cl(B) isomo rphic to a division ring H of quaternions. Knowing that the given pol ynomial p is of that type allows for finding the inverse of p in A < C l(B) a more efficient way by the procedure 'cinv'.\n\nNote that elemen ts of grade 0 (eg., 2*Id) and elements of type 'gencomplex' - a genera lized complex element of Cl(B), are not of this type.\n\nTypical use: \+ type(p,genquaternion);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 665 "`type/ genquaternion`:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) lo cal L;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: September 17, 2005`;\n############################################# \nif not type(B,matrix) then \n error \"square matrix must be assign ed to B\" \nend if:\nif type(a1,cliscalar) then return false end if:\n L:=[op(cliterms(reorder(a1)))];\nif nops(L)>4 or type(a1,gencomplex) t hen return false end if:\nL:=remove(member,L,[Id]);\nif nops(L)=1 then return false end if:\nif nops(L)=2 then L:=[op(L),cmul(L[1],L[2])] en d if:\nreturn type(L,purequatbasis)\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 26 "No. 18/19. Two new types: " }{TEXT 460 11 "evenelement" } {TEXT -1 5 " and " }{TEXT 459 10 "oddelement" }{TEXT -1 242 " in Cl(B) . These two type-checking procedures determine whether their inputs a re even elements, odd elements, or neither in Cl(B).\n\nTypical use: t ype(p,evenelement);\n type(p,oddelement);\n\nwhere \+ p is a Clifford polynomial.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 779 "` type/evenelement`:=proc(a1::\{cliscalar,clibasmon,climon,clipolynom\}) \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried F auser. All rights reserved.`;\ndescription `Last revised: September 17 , 2005`;\n#############################################\nif type(eval( a1),cliscalar) then return true end if:\nreturn evalb(reorder(displayi d(eval(a1)-gradeinv(eval(a1))))=0)\nend proc:\n\n`type/oddelement`:=pr oc(a1::\{cliscalar,clibasmon,climon,clipolynom\})\noptions `Copyright \+ (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: September 17, 2005`;\n########### ##################################\nif type(eval(a1),cliscalar) then r eturn false end if:\nreturn evalb(reorder(displayid(eval(a1)+gradeinv( eval(a1))))=0)\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 424 18 "No. 20. N ew type: " }{TEXT 461 10 "quaternion" }{TEXT 462 1 "\n" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 898 "`type/quaternion`:=proc(q::algebraic) local a a1,aa2,S;global B,qi,qj,qk;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: September 17, 2005`;\n################################# ############\nif not assigned(B) or not type(B,matrix) then \n error \"bilinear form B has not been assigned yet. It must be defined as th e identity 3 x 3 matrix.\"\nend if:\nif not linalg[equal](B,linalg[dia g](1$3)) then \n error \"identity 3 x 3 matrix must be assigned to B \" \nend if:\nif not type(eval(q),\{'clibasmon','climon','clipolynom' \}) then \n error \"wrong input type: input must be of type 'clibasm on','climon', or 'clipolynom'\" \nend if:\naa1:=\{op(cliterms(reorder( expand(eval(q)))))\};\naa2:=\{Id,e1we2,e1we3,e2we3\};#standard basis t o 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 'G raded Tensor Product'. This is an experimental package for computatio ns with graded tensor products of Clifford algebras." }{TEXT -1 1 "\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 334 "`type/tensorprod`:=proc(a1::an ything)\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bert fried Fauser. All rights reserved.`;\ndescription `Last revised: Septe mber 17, 2005`;\n#############################################\nif typ e(a1,function) and op(0,a1)=`&t` then return true else return false en d if:\nreturn false\nend proc:" }}{PARA 0 "" 0 "" {TEXT -1 0 "" } {MPLTEXT 1 0 0 "" }}{PARA 0 "" 0 "" {TEXT 422 18 "No. 22. New type: " }{TEXT 465 12 "genquatbasis" }{TEXT 466 187 ". This procedure checks i f the given list or set of four elements is a basis for generalized qu aternionic ring.\n\nUse: type([p1,p2,p3,p4], genquatbasis);type(\{p1,p 2,p3,p4\}, genquatbasis);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1477 "`t ype/genquatbasis`:=proc(L::\{list(\{cliscalar,clibasmon,climon,clipoly nom\}),\n set(\{cliscalar,clibasmon,climo n,clipolynom\})\}) \nlocal f,p,q,k,loc,i;global B;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights re served.`;\n#############################################\ndescription \+ `Last revised: September 17, 2005`;\nif nops(L) <> 4 or nops(L)<>nops( convert(L,set)) then \n error \"list or set must have exactly 4 diff erent elements\" \nend if:\nif not type(B,matrix) then \n error \"sq uare matrix must be assigned to B first\" \nend if: \nf:=op(select(typ e,L,idempotent)): #select idempotent in L\nif f=NULL then \n error \+ \"one element in the list must be an idempotent\" \nend if:\nloc:=remo ve(member,L,\{f\}); #assign remaining elements of L to loc \np ,q,k:=seq(loc[i],i=1..3): #assign elements of loc to p,q,k\n### ###############################\nif cmul(p,p)<>cmul(-Id,f) then return false elif\n cmul(q,q)<>cmul(-Id,f) then return false 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) and \n cmul(k,p) =cmul(q,f) and cmul(p,k)=-cmul(q,f)) \nor\n (cmul(p,q)=-cmul(k,f) an d cmul(q,p)=cmul(k,f) and \n cmul(q,k)=-cmul(p,f) and cmul(k,q)=cmu l(p,f) and \n cmul(k,p)=-cmul(q,f) and cmul(p,k)=cmul(q,f))\nthen r eturn true \nelse\n return false\nend if:\nend proc:\n" }}{PARA 258 "" 0 "" {TEXT -1 16 "No. 23. New type" }{TEXT 421 2 ": " }{TEXT 467 7 "cliprod" }{TEXT 468 117 "\n\nUse: type(e1we2 &C e3, cliprod); type(`& C`(e1,e2),cliprod); type(`&C`[K](e1,e2),cliprod); type(&C(e1,e2),clipr od);\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 318 "`type/cliprod`:=proc(f:: \{function,anything\}) local p;\noptions `Copyright (c) 1995-2005 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: September 17, 2005`;\n############################# ################\nevalb(member(op(0,f),\{`&C`\}) or member(op(0,op(0,f )),\{`&C`\}))\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 433 18 "No. 24. Pr ocedure " }{TEXT 469 16 "convert/dfmatrix" }{TEXT 470 84 " converts a \+ list of matrices or a pair of matrices inot a matrix over double field .\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 970 "`convert/dfmatrix`:=proc() \+ local l1,l2,L,i,j,m,n,m1,m2,MN;\noptions `Copyright (c) 1995-2005 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: September 17, 2005`;\n############################# ################\nif nargs=1 and type(args[1],dfmatrix) \n \+ then return args[1]\nelif nargs=1 and type(args[1],list(\{matrix,ar ray\})) \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(ar gs[2])\nelse error \"wrong number or types of arguments\" \nend if:\n \+ l1 := convert(m1,mlist);\n l2 := convert(m2,mlist);\n L := [] ;\n for i to nops(l1) do L := [op(L), [l1[i], l2[i]]] end do:\n \+ m := linalg[rowdim](m1);\n n := linalg[rowdim](m1);\n MN := lina lg[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 498 "`type/dfmatrix`:=proc(m::anything) local mm;\noption s `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. A ll rights reserved.`;\ndescription `Last revised: September 17, 2005`; \n#############################################\nif not type(m,matrix) and not type(m,list(matrix)) then return false end if:\nif type(m,mat rix) then \n return type(convert(m,mlist),\n list(list(\{cl iscalar,clibasmon,climon,clipolynom,numeric,symbol,algebraic\})))\nels e\n return false\nend if:\nend proc:\n" }}{PARA 0 "" 0 "" {TEXT 477 79 "In this version we define all ampersand operators as global in Cli fford:-setup:" }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2306 "`&c`:=proc() local NP,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. Al l rights reserved.`;\ndescription `Last revised: September 17, 2005`; \n#############################################\n##################### ##################\n### Works when &c[''K''] or &c[''-K''] is entered \+ and K is a matrix\n#######################################\nflagdec:=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 &c[''B''] or &c[''-B''] when B has been \+ assigned a matrix to avoid the following:\");\n return 'procnam e(args)';\n end if;\n else coB:=1:\n nameB:=`B`:\n l name:=`B`:\n ARGS:=[args]:\n flagdec:=false:\n end if;\n else lname:=op(procname);\n ARGS:=[args];\n if type(lname,`&*` (numeric,name)) then\n coB:=op(select(type,\{op(lname)\},numer ic));\n nameB:=op(select(type,\{op(lname)\},name));\n else \n coB:=1:\n nameB:=lname:\n end if;\n flagde c:=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)\},numer ic));\n nameB:=op(select(type,\{op(nameB)\},name));\n en d if;\n elif type(op(args),`&*`(numeric,function)) then\n nameB :=\{op(op(args))\}:\n coB:=op(select(type,nameB,numeric));\n \+ nameB:=op(select(type,nameB,function));\n ARGS:=op(nameB);\n \+ nameB:=op(0,nameB);\n else\n error \"unable to determine inde x 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 dete rmine arguments and/or index from arguments\"\n end if;\nreturn coB,na meB,[ARGS];\nend proc:\n#####################################\nif flag dec then \n coB,nameB,ARGS:=decindex(args);\n lname:=coB*nameB;\ne nd if;\nNP:=nops(ARGS);\nif member(0,ARGS) then return 0 end if;\nif N P <=1 then return op(ARGS) end if;\nreturn cmul[eval(lname)](op(ARGS)) ; \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2382 "`&cQ`:=proc() \+ local NP,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyright (c ) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reser ved.`;\ndescription `Last revised: September 17, 2005`;\n############# ################################\n#################################### ###\n### Works when &cQ[''K''] or &cQ[''-K''] is entered and K is a ma trix\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 dou ble quotes as in &cQ[''B''] or &cQ[''-B''] when B has been assigned a \+ matrix to avoid the following:\");\n return 'procname(args)';\n end if;\n else coB:=1:\n nameB:=`B`:\n lname:=`B`: \n ARGS:=[args]:\n flagdec:=false:\n end if;\nelse lname :=op(procname);\n ARGS:=[args];\n if type(lname,`&*`(numeric,n ame)) then\n coB:=op(select(type,\{op(lname)\},numeric));\n \+ nameB:=op(select(type,\{op(lname)\},name));\n else\n \+ coB:=1:\n nameB:=lname:\n end if;\n flagdec:=false: \n end if;\n#######################################\ndecindex:=proc() \+ local ARGS,coB,nameB;global B;\nif type([args],listlist) then\n if t ype(op(args),function) then\n ARGS:=op(op(args));\n coB:=1: \n nameB:=eval(op(0,op(args)));\n if type(nameB,`&*`(numeric ,name)) then\n coB:=op(select(type,\{op(nameB)\},numeric));\n \+ nameB:=op(select(type,\{op(nameB)\},name));\n end if;\n \+ elif type(op(args),`&*`(numeric,function)) then\n nameB:=\{op(o p(args))\}:\n coB:=op(select(type,nameB,numeric));\n nameB:= op(select(type,nameB,function));\n ARGS:=op(nameB);\n nameB: =op(0,nameB);\n else\n error \"unable to determine index from o r wrong index, use name in double quotes as in &cQ[''B''] or &cQ[''-B' ']\"\n end if;\nelif\n type([args],list) then\n ARGS:=args;\n \+ coB:=1:\n nameB:=`B`; #default name \nelse\n error \"cannot determ ine arguments and/or index from arguments\"\nend if;\nreturn coB,nameB ,[ARGS];\nend proc:\n#####################################\nif flagdec then \n coB,nameB,ARGS:=decindex(args);\n lname:=coB*nameB;\nend \+ if;\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` \nen d proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1857 "`&cQm`:=proc() local ARGS,lname,NP,coB,nameB,decindex;\noptions `Copyright (c) 1995-2005 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescr iption `Last revised: September 17, 2005`;\n########################## ###################\n#######################################\nif 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''] whe n B has been assigned a matrix to avoid the following:\");\n retu rn ('procname(args)');\n end if;\nend if;\n######################### ##############\ndecindex:=proc() local ARGS,coB,nameB;global B;\nif ty pe([args],listlist) then\n if type(op(args),function) then\n AR GS:=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(nam eB)\},name));\n end if;\n elif type(op(args),`&*`(numeric,func tion)) then\n nameB:=\{op(op(args))\}:\n coB:=op(select(type ,nameB,numeric));\n nameB:=op(select(type,nameB,function));\n \+ ARGS:=op(nameB);\n nameB:=op(0,nameB);\n else\n error \" unable to determine index or wrong index type for &cQm, try enclosing \+ name of the index in double quotes as in &cQm[''B''] or &cQm[''-B'']\" \n end if;\nelif\n type([args],list) then\n ARGS:=args;\n coB: =1:\n nameB:=`B`; #default name \nelse\n error \"cannot determine \+ arguments and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\nend proc: \n#####################################\ncoB,nameB,ARGS:=decindex(args );\nlname:=coB*nameB:\n NP:=nops(ARGS);\n if member(0,ARGS) then ret urn 0 end if;\n if NP <=1 then \n return op(ARGS)\n elif NP = 2 \+ then \n return rmulm(eval(ARGS[1]),eval(ARGS[2]),cmulQ,lname) \n \+ else\n error \"only two arguments and index are allowed\"\n end i f;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2449 "`&cm`:=proc() \+ local NP,ARGS,coB,nameB,lname,decindex,flagdec;\noptions `Copyright (c ) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reser ved.`;\ndescription `Last revised: September 17, 2005`;\n############# ################################\n#################################### ###\n### Works when &cm[''K''] or &cm[''-K''] is entered and K is a ma trix\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 dou ble quotes as in &cm[''B''] or &cm[''-B''] when B has been assigned a \+ matrix to avoid the following:\");\n return 'procname(args)'; \n end if;\n else coB:=1:\n nameB:=`B`:\n lname:= `B`:\n ARGS:=[args]:\n flagdec:=false:\n end if;\nelse lname:=op(procname);\n ARGS:=[args];\n if type(lname,`&*`(num eric,name)) then\n coB:=op(select(type,\{op(lname)\},numeric)) ;\n nameB:=op(select(type,\{op(lname)\},name));\n else\n \+ coB:=1:\n nameB:=lname:\n end if;\n flagdec:=f alse:\nend if;\n#######################################\ndecindex:=pro c() 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,`&*`(nume ric,name)) then\n coB:=op(select(type,\{op(nameB)\},numeric)); \n nameB:=op(select(type,\{op(nameB)\},name));\n end if; \n elif type(op(args),`&*`(numeric,function)) then\n nameB:=\{o p(op(args))\}:\n coB:=op(select(type,nameB,numeric));\n name B:=op(select(type,nameB,function));\n ARGS:=op(nameB);\n nam eB:=op(0,nameB);\n else\n error \"unable to determine index 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 co B:=1:\n nameB:=`B`; #default name \nelse\n error \"cannot determin e arguments and/or index\"\nend if;\nreturn coB,nameB,[ARGS];\nend pro c:\n#####################################\nif flagdec then \n coB,na meB,ARGS:=decindex(args);\n lname:=coB*nameB;\n end if;\n#return (co B,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 the n \n return rmulm(eval(ARGS[1]),eval(ARGS[2]),cmul,lname) \n else \n error \"only two arguments and index are allowed\"\n end if;\n end proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 234 "`&q`:=proc()\noptio ns `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: September 17, 2005` ;\n#############################################\nreturn qmul(args) \n end proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 467 "`&qm`:=proc() local NP: \noptions `Copyright (c) 1995-2005 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Septemb er 17, 2005`;\n#############################################\n NP:=no ps([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(a rgs[1]),eval(args[2]),qmul) \n else\n error \"only two arguments \+ are allowed in &qm\"\n end if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 351 "`&om`:=proc()\noptions `Copyright (c) 1995-2005 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: September 17, 2005`;\n############################# ################\nif not assigned(Octonion) then\n error \"package ' Octonion' must be loaded first\"\nend if;\nreturn subs(Id=1,rmulm(args ,Octonion:-omul))\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1849 "`&rm`:=proc() local ARGS,lname,NP,coB,nameB,decindex;\noptions `Copyr ight (c) 1995-2005 by Rafal Ablamowicz and Bertfried Fauser. All right s reserved.`;\ndescription `Last revised: September 17, 2005`;\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 followin g:\");\n return 'procname(args)';\n end if;\nend if;\n######### ##############################\ndecindex:=proc() local ARGS,coB,nameB; global B;\nif type([args],listlist) then\n if type(op(args),function ) then\n ARGS:=op(op(args));\n coB:=1:\n nameB:=eval(op (0,op(args)));\n if type(nameB,`&*`(numeric,name)) then\n \+ coB:=op(select(type,\{op(nameB)\},numeric));\n nameB:=op(sele ct(type,\{op(nameB)\},name));\n end if;\n elif type(op(args),` &*`(numeric,function)) then\n nameB:=\{op(op(args))\}:\n coB :=op(select(type,nameB,numeric));\n nameB:=op(select(type,nameB,f unction));\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:=a rgs;\n coB:=1:\n nameB:=`B`; #default name \nelse\n error \"cann ot determine arguments and/or index\"\nend if;\nreturn coB,nameB,[ARGS ];\nend proc:\n#####################################\ncoB,nameB,ARGS:= decindex(args);\nlname:=coB*nameB:\n NP:=nops(ARGS);\n if member(0,A RGS) 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]),`&r` ,lname) \n else\n error \"only two arguments and index are allowe d\"\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 468 "`&wm`:=proc() local NP: \noptions `Copyright (c) 199 5-2005 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.` ;\ndescription `Last revised: September 17, 2005`;\n################## ###########################\n NP:=nops([args]);\n if member(0,[args] ) then return 0 end if;\n if NP <=1 then \n return args\n elif N P = 2 then \n return rmulm(eval(args[1]),eval(args[2]),wedge) \n \+ else\n error \"only two arguments are allowed in &wm\"\n end if; \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 187 "################# ###################################\nend proc: ###<< " 0 "" {MPLTEXT 1 0 21 "savelib('Clifford'):\n" }}{PARA 8 "" 1 "" {TEXT -1 71 "Error, (in savelib) unable to save [Clifford] in C:\\Maple8/Cliffo rdlib\n" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 "march('listdir', libname[1]);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#7#7&Q@C:\\Maple8/Cliff ordlib\\maple.lib6\"7(\"%.?\"\"\"\"\"&\"#8\"#P\"\"(Q)WRITABLEF&\"\"!" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 59 "Let's add library files to the \+ main library in libname[1]:\n" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 449 "march('add',libname[1],`C:\\\\Maple8/Clifforddata/matrealL.m`,` matrealL.m`);\nmarch('add',libname[1],`C:\\\\Maple8/Clifforddata/matre alR.m`,`matrealR.m`);\nmarch('add',libname[1],`C:\\\\Maple8/Cliffordda ta/matcompL.m`,`matcompL.m`);\nmarch('add',libname[1],`C:\\\\Maple8/Cl ifforddata/matcompR.m`,`matcompR.m`);\nmarch('add',libname[1],`C:\\\\M aple8/Clifforddata/matquatL.m`,`matquatL.m`);\nmarch('add',libname[1], `C:\\\\Maple8/Clifforddata/matquatR.m`,`matquatR.m`);" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 48 "and verify that indeed addition has taken place:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matrealL );" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"%\"\"#7#7$F%F%7#7$\"\"\" F+7#7$\"\"&\"\"$7#7$\"\"!\"\"(7#7$F2\"\")7#7$\"\"*F27#7$F/F+7#7$F+F67# 7$F2\"\"'7#7$F/F&7#7$F.F%7#7$F&F&7#7$F+F37#7$F/F/7#7$F%F/7#7$F&F+7#7$F &F27#7$F6F2" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices(matr ealR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"\"\"\")7#7$\"\"%F)7# 7$\"\"$F%7#7$\"\"#F%7#7$\"\"!\"\"(7#7$F)F,7#7$F/F27#7$F)F/7#7$F/F/7#7$ F,F/7#7$\"\"*F27#7$F2F&7#7$\"\"&F)7#7$F&F27#7$F,F,7#7$F%F37#7$F%F%7#7$ FEF,7#7$F2\"\"'" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indices( matcompL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\")\"\"\"7#7$\"\"% F&7#7$\"\"'\"\"$7#7$\"\"#\"\"(7#7$F0F-7#7$F-\"\"!7#7$F6\"\"&7#7$F6\"\" *7#7$F-F)7#7$F9F07#7$F1F67#7$F&F07#7$F)F97#7$F&F," }}}{EXCHG {PARA 0 " > " 0 "" {MPLTEXT 1 0 18 "indices(matcompR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "607#7$\"\")\"\"\"7#7$\"\"%F&7#7$\"\"'\"\"$7#7$\"\"#\"\"(7 #7$F0F-7#7$F-\"\"!7#7$F6\"\"&7#7$F6\"\"*7#7$F-F)7#7$F9F07#7$F1F67#7$F& F07#7$F)F97#7$F&F," }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indic es(matquatL);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"$\"\"&7#7$\" \"'\"\"\"7#7$F&F*7#7$F%F)7#7$\"\"%\"\"!7#7$F*F&7#7$\"\"(\"\"#7#7$F2F17 #7$F8F17#7$F&F27#7$F2F%7#7$F)F87#7$F8F&7#7$F)F27#7$F*F17#7$F*F%7#7$F7F *7#7$F2F87#7$F8F)" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "indice s(matquatR);" }}{PARA 11 "" 1 "" {XPPMATH 20 "657#7$\"\"$\"\"&7#7$\"\" '\"\"\"7#7$F&F*7#7$F%F)7#7$\"\"%\"\"!7#7$F*F&7#7$\"\"(\"\"#7#7$F2F17#7 $F8F17#7$F&F27#7$F2F%7#7$F)F87#7$F8F&7#7$F)F27#7$F*F17#7$F*F%7#7$F7F*7 #7$F2F87#7$F8F)" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 258 "" 0 "" {TEXT -1 22 "Last revised: 9-7-2005" }}{PARA 0 "" 0 "" {TEXT -1 952 "NOTES:\n\n1. The table name, e.g., Clifford, a nd the file name, e.g., Clifford.m must be the same.\n2. March command s useful in creating and viewing library file (issue in DOS window):\n \nC:\\Maple8>bin.wnt\\march -c Cliffordlib 20 - creates library in \+ a existing empty directory \\Cliffordlib\nC:\\Maple8>bin.wnt\\march -l Cliffordlib - list all entries in the library Cliffordlib\nC:\\Maple 8>bin.wnt\\march -l Cliffordlib > list.txt - list all entries in the \+ library Cliffordlib and write them into file list.txt\nC:\\Maple8>bin. wnt\\march -d Cliffordlib Clifford.m - delete Clifford.m from the lib rary Cliffordlib\n\n3. Global variable savelibname is empty, but savel ib() automatically assigns libname[1] to savelibname for the purpose o f saving package there with the command savelib().\n4. Maple initializ ation file maple.ini contains libname augmented by the path and the di rectory name \\Cliffordlib where the Clifford library with Clifford.m \+ will be located. " }{MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 198 "########################### ############################\n###end module:\n###march('create',Cliffo rdlib,500);\n###savelib(Clifford,`Clifford.m`):\n##################### ###################################" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}} {MARK "0 558 0" 106 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }