|
4 | 4 | !>
|
5 | 5 | !> The specification of this module is available [here](../page/specs/stdlib_strings.html).
|
6 | 6 | module stdlib_strings
|
7 |
| - use stdlib_ascii, only : whitespace |
8 |
| - use stdlib_string_type, only : string_type, char, verify |
| 7 | + use stdlib_ascii, only: whitespace |
| 8 | + use stdlib_string_type, only: string_type, char, verify |
| 9 | + use stdlib_optval, only: optval |
9 | 10 | implicit none
|
10 | 11 | private
|
11 | 12 |
|
12 | 13 | public :: strip, chomp
|
13 | 14 | public :: starts_with, ends_with
|
14 |
| - public :: slice |
| 15 | + public :: slice, find |
15 | 16 |
|
16 | 17 |
|
17 | 18 | !> Remove leading and trailing whitespace characters.
|
@@ -67,6 +68,16 @@ module stdlib_strings
|
67 | 68 | module procedure :: slice_char
|
68 | 69 | end interface slice
|
69 | 70 |
|
| 71 | + !> Finds the starting index of substring 'pattern' in the input 'string' |
| 72 | + !> [Specifications](link to the specs - to be completed) |
| 73 | + !> |
| 74 | + !> Version: experimental |
| 75 | + interface find |
| 76 | + module procedure :: find_string_string |
| 77 | + module procedure :: find_string_char |
| 78 | + module procedure :: find_char_string |
| 79 | + module procedure :: find_char_char |
| 80 | + end interface find |
70 | 81 |
|
71 | 82 | contains
|
72 | 83 |
|
@@ -366,5 +377,127 @@ pure function slice_char(string, first, last, stride) result(sliced_string)
|
366 | 377 | end do
|
367 | 378 | end function slice_char
|
368 | 379 |
|
| 380 | + !> Returns the starting index of the 'occurrence'th occurrence of substring 'pattern' |
| 381 | + !> in input 'string' |
| 382 | + !> Returns an integer |
| 383 | + elemental function find_string_string(string, pattern, occurrence, consider_overlapping) result(res) |
| 384 | + type(string_type), intent(in) :: string |
| 385 | + type(string_type), intent(in) :: pattern |
| 386 | + integer, intent(in), optional :: occurrence |
| 387 | + logical, intent(in), optional :: consider_overlapping |
| 388 | + integer :: res |
| 389 | + |
| 390 | + res = find(char(string), char(pattern), occurrence, consider_overlapping) |
| 391 | + |
| 392 | + end function find_string_string |
| 393 | + |
| 394 | + !> Returns the starting index of the 'occurrence'th occurrence of substring 'pattern' |
| 395 | + !> in input 'string' |
| 396 | + !> Returns an integer |
| 397 | + elemental function find_string_char(string, pattern, occurrence, consider_overlapping) result(res) |
| 398 | + type(string_type), intent(in) :: string |
| 399 | + character(len=*), intent(in) :: pattern |
| 400 | + integer, intent(in), optional :: occurrence |
| 401 | + logical, intent(in), optional :: consider_overlapping |
| 402 | + integer :: res |
| 403 | + |
| 404 | + res = find(char(string), pattern, occurrence, consider_overlapping) |
| 405 | + |
| 406 | + end function find_string_char |
| 407 | + |
| 408 | + !> Returns the starting index of the 'occurrence'th occurrence of substring 'pattern' |
| 409 | + !> in input 'string' |
| 410 | + !> Returns an integer |
| 411 | + elemental function find_char_string(string, pattern, occurrence, consider_overlapping) result(res) |
| 412 | + character(len=*), intent(in) :: string |
| 413 | + type(string_type), intent(in) :: pattern |
| 414 | + integer, intent(in), optional :: occurrence |
| 415 | + logical, intent(in), optional :: consider_overlapping |
| 416 | + integer :: res |
| 417 | + |
| 418 | + res = find(string, char(pattern), occurrence, consider_overlapping) |
| 419 | + |
| 420 | + end function find_char_string |
| 421 | + |
| 422 | + !> Returns the starting index of the 'occurrence'th occurrence of substring 'pattern' |
| 423 | + !> in input 'string' |
| 424 | + !> Returns an integer |
| 425 | + elemental function find_char_char(string, pattern, occurrence, consider_overlapping) result(res) |
| 426 | + character(len=*), intent(in) :: string |
| 427 | + character(len=*), intent(in) :: pattern |
| 428 | + integer, intent(in), optional :: occurrence |
| 429 | + logical, intent(in), optional :: consider_overlapping |
| 430 | + integer :: lps_array(len(pattern)) |
| 431 | + integer :: res, s_i, p_i, length_string, length_pattern, occurrence_ |
| 432 | + logical :: consider_overlapping_ |
| 433 | + |
| 434 | + consider_overlapping_ = optval(consider_overlapping, .true.) |
| 435 | + occurrence_ = optval(occurrence, 1) |
| 436 | + res = 0 |
| 437 | + length_string = len(string) |
| 438 | + length_pattern = len(pattern) |
| 439 | + |
| 440 | + if (length_pattern > 0 .and. length_pattern <= length_string & |
| 441 | + & .and. occurrence_ > 0) then |
| 442 | + lps_array = compute_lps(pattern) |
| 443 | + |
| 444 | + s_i = 1 |
| 445 | + p_i = 1 |
| 446 | + do while(s_i <= length_string) |
| 447 | + if (string(s_i:s_i) == pattern(p_i:p_i)) then |
| 448 | + if (p_i == length_pattern) then |
| 449 | + occurrence_ = occurrence_ - 1 |
| 450 | + if (occurrence_ == 0) then |
| 451 | + res = s_i - length_pattern + 1 |
| 452 | + exit |
| 453 | + else if (consider_overlapping_) then |
| 454 | + p_i = lps_array(p_i) |
| 455 | + else |
| 456 | + p_i = 0 |
| 457 | + end if |
| 458 | + end if |
| 459 | + s_i = s_i + 1 |
| 460 | + p_i = p_i + 1 |
| 461 | + else if (p_i > 1) then |
| 462 | + p_i = lps_array(p_i - 1) + 1 |
| 463 | + else |
| 464 | + s_i = s_i + 1 |
| 465 | + end if |
| 466 | + end do |
| 467 | + end if |
| 468 | + |
| 469 | + end function find_char_char |
| 470 | + |
| 471 | + !> Computes longest prefix suffix for each index of the input 'string' |
| 472 | + !> |
| 473 | + !> Returns an array of integers |
| 474 | + pure function compute_lps(string) result(lps_array) |
| 475 | + character(len=*), intent(in) :: string |
| 476 | + integer :: lps_array(len(string)) |
| 477 | + integer :: i, j, length_string |
| 478 | + |
| 479 | + length_string = len(string) |
| 480 | + |
| 481 | + if (length_string > 0) then |
| 482 | + lps_array(1) = 0 |
| 483 | + |
| 484 | + i = 2 |
| 485 | + j = 1 |
| 486 | + do while (i <= length_string) |
| 487 | + if (string(j:j) == string(i:i)) then |
| 488 | + lps_array(i) = j |
| 489 | + i = i + 1 |
| 490 | + j = j + 1 |
| 491 | + else if (j > 1) then |
| 492 | + j = lps_array(j - 1) + 1 |
| 493 | + else |
| 494 | + lps_array(i) = 0 |
| 495 | + i = i + 1 |
| 496 | + end if |
| 497 | + end do |
| 498 | + end if |
| 499 | + |
| 500 | + end function compute_lps |
| 501 | + |
369 | 502 |
|
370 | 503 | end module stdlib_strings
|
0 commit comments